#!/usr/bin/perl -w
# This is part of ypp-sc-tools, a set of third-party tools for assisting
# players of Yohoho Puzzle Pirates.
#
# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
# are used without permission.  This program is not endorsed or
# sponsored by Three Rings.

use strict qw(vars);
use IO::Handle;
use POSIX;

my $usage = <<END
usage:
  .../ypp-restock-rum [<information> ...]

where <information> is

  have  [<swill> <grog>] <fine> [<hold_shot>+<loaded_shot>]
  want  [<swill> <grog>] <fine> [<shot>]
  price  <swill> <grog>  <fine> [<shot>]

Each of which may appear only once, except \`have' which may appear
more than once which case we calculate the financial implications
at each stage.

Missing entries count as zero (and zeroes are not displayed in the output).
In price, \`x' means the commodity is unavailable.

The intended use is that at the start of the pillage you run:
   ypp-restock-rum have ... want ...
to check that stocks are sufficient, or perhaps:
   ypp-restock-rum have ... want ... price ...
if you want to stock up some more.  At the end of the pillage,
run the same thing again with some extra parameters:
   ypp-restock-rum have .. want ... have ... price ...
and it will tell you how you did and what the restock should be like.
END
;

our (@kinds) = qw(Swill Grog Fine Shot);
our (@proofs) = qw(40 60 100);

sub parse_info ($$$\@$) {
    my ($omitswgok,$default,$multishot, $storeary, $what) = @_;
    @ARGV or badusage("missing value for information argument \`$_'");
    badusage("$what: specified more than once")
	if defined $storeary->[2];
    my (@v) = ();
    while (@ARGV and $ARGV[0] =~ m/^\d|^x$/) {
	$_ = shift @ARGV;
	push @v, $_;
    }
    if (@v==1 or @v==2) {
	badusage("$what: swill and grog amounts must be specified")
	    unless $omitswgok;
	@v=($default,$default,@v);
    }
    if ($multishot and @v==4 and length $v[3]) {
	$v[3] =~ m/^0*(\d+)\+0*(\d+)$/ or
	    badusage("$what: shot must be specified as <hold>+<loaded>");
	$v[3] = $1 + $2;
    }
    if (@v==3) {
	push @v, $default;
    }
    if (@v != 4) {
	badusage("$what: invalid syntax (wrong number of parameters)");
    }
    my $i=0;
    foreach $_ (@v) {
	if ($default>0 and m/^x$/) {
	    $_ = $default;
	} elsif (m/^0*(\d+)$/) {
	    $_= $1;
	} else {
	    badusage("$what: $kinds[$i] \`$_': bad syntax");
	}
	$i++;
    }
    @$storeary = @v;
}

our (@have,@want,@price);

sub parse_args () {
    if (!@ARGV) {
	print STDERR <<END or die $!;

ypp-restock-rum is part of ypp-sc-tools  Copyright (C) 2009 Ian Jackson
This program comes with ABSOLUTELY NO WARRANTY; this is free software,
and you are welcome to redistribute it under certain conditions.
For details, read the top of the ypp-restock-rum file.
END
        badusage("need some information to go on");
    }
    while (@ARGV) {
	$_ = shift @ARGV;
	if (m/^have$/) {
	    parse_info(1,0,1, @{ $have[@have] }, 'have');
	} elsif (m/^want$/) {
	    parse_info(1,0,0, @want, 'want');
	} elsif (m/^prices?$|^costs?$/) {
	    parse_info(0,1e7,0, @price, 'price');
	} else {
	    badusage("unknown information argument \`$_'");
	}
    }
}

sub badusage ($) {
    my ($m) = @_;
    print STDERR "\nbad usage: $m\n\n$usage\n";
    exit 16;
}

our $ff = '%6.1f';

sub valid ($) {
    my ($x) = @_;
    defined $x and $x and $x<1e5;
}    

sub prvff ($$\@$) {
    my ($what, $format, $ary, $unit) = @_;
    printf("%-25s", "$what:");
    for my $i (qw(0 1 2 3)) {
	my $x= $ary->[$i];
	my $y= valid($x) ? sprintf $format, $x : '    ';
	printf " %-9s", $y;
    }
    printf "  %s\n", $unit;
}

sub pr ($\@$) {
    my ($what, $ary, $unit) = @_;
    prvff($what, '%4d  ', @$ary, $unit);
}

sub prf ($\@$) {
    my ($what, $ary, $unit) = @_;
    prvff($what, $ff, @$ary, $unit);
}

sub pr1 ($$) {
    my ($k,$v) = @_;
    printf "%-20s %s\n", "$k:", $v;
}
sub fmt_stock_index ($) {
    my ($si) = @_;
    @have==1 ? '' : ' #'.$si;
}

sub rum_total (\@) {
    my ($rums) = @_;
    my $total= 0;
    foreach my $i (qw(0 1 2)) {
	$total += $rums->[$i] * $proofs[$i] / 100;
    }
    return $total;
}

our @norm_price;
our ($best, $best_norm_price);

sub print_inputs () {
    printf("%25s",'');
    map { printf " %5s    ", $_ } @kinds;
    print "\n\n";
    pr('prices', @price, 'poe ea.') if valid(@price);
    pr('target stocks', @want, 'units') if valid(@want);
    my $si=0; for my $stocks (@have) {
	pr('actual stocks'.fmt_stock_index(++$si),
	   @$stocks, 'units');
    }
    print "\n";
}

sub compute_cheapest_rum() {
    return unless @price;

    my (@perorder) = map { $_*10 } @price;
    prf('equiv. ordering price', @perorder, 'poe/order');

    $best= undef;
    $best_norm_price= 1e6;
    for my $i (qw(0 1 2)) {
	next unless $price[$i];
	$norm_price[$i] = $price[$i] * 100 / $proofs[$i];
	if ($norm_price[$i] <= $best_norm_price) {
	    $best= $i;
	    $best_norm_price= $norm_price[$i];
	}
    };
    prf('normalised prices', @norm_price, 'poe/fine');

    if (defined $best) {
	printf "best is %-10s%*s^^\n",
	    $kinds[$best],
	    $best*10+10, '';
	my (@bestperorder) = map {
	    $best_norm_price * $proofs[$_] / 100 * 10;
	} qw(0 1 2);
	#push @bestperorder, $perorder[3];
	prf('best is equiv. ordering', @bestperorder, 'poe/order');
    }
    print "\n";
}

sub pr1s ($) {
    my ($x) = @_;
    if (valid($x)) {
	printf ' %9.1f', $x;
    } else {
	printf "          ";
    }
}

sub compute_stock_values() {
    return unless @have;
    print @have>1 ? <<END

                _____Rum_____      ___Shot___      total      _____Profit___
             fine equiv.  value   qty    value     value     per leg     total
END
: <<END
                             Rum      Rum             Shot    Shot     total
                            equiv.   value           stocks   value    value
END
;

    my $initial_value;
    my $last_value;
    my $si=0; for my $stocks (@have) {
	my $stock_rum = rum_total(@$stocks);
	my $rum_value= defined($best) ? $stock_rum * $best_norm_price : 0;
	my $shot_value= valid($price[3]) ? $stocks->[3] * $price[3] : 0;
	my $total_value= $rum_value + $shot_value;

	printf "%-10s ", 'stocks'.fmt_stock_index(++$si).':';
	print '            ' if @have==1;
	pr1s($stock_rum);
	pr1s($rum_value);
	print '        ' if @have==1;
	printf "%6s", $stocks->[3] ? $stocks->[3] : '';
	pr1s($shot_value);
	pr1s($total_value);
	
	if (defined $last_value) {
	    printf(" %10.1f %10.1f",
		   $total_value - $last_value,
		   $total_value - $initial_value);
	}
	$initial_value= $total_value unless defined $initial_value;
	$last_value= $total_value;
	print "\n";
    }
    print "\n" if @have>1;
    print "\n";
}

sub pr2 ($$$) {
    my ($k,$v1,$v2) = @_;
    printf "%-25s %-23s %s\n", "$k:", $v1, $v2;
}

sub pr2rs ($$$) {
    my ($k,$rum,$shot) = @_;
    pr2($k,
	valid($rum) ? sprintf("%12.1f fine equiv", $rum) : '',
	valid($shot) ? sprintf("%10d shot", $shot) : '');
}

sub compute_restock_requirements () {
    return unless @want;
    
    my $rum_want= rum_total(@want);

    my $stocks= @have ? $have[-1] : [qw(0 0 0 0)];
    my $rum_have= rum_total(@$stocks);
    
    pr2rs('desired stock level', $rum_want, $want[3]);

    my $rum_need = $rum_want - $rum_have;
    my $shot_need = $want[3] - $stocks->[3];

    if (@have) {
	pr2rs('current stock', $rum_have, $stocks->[3]);
	pr2rs('restock requirement', $rum_need, $shot_need);
	print "\n";
    }

    if (@price) {
	my ($rum_buy,$shot_buy) = ('','');
	my ($rum_bill,$shot_bill) = qw(0 0);
	my $ok=1;
	if ($rum_need > 0) {
	    if (defined $best) {
		my $rum_qty= $rum_need * 100 / $proofs[$best];
		$rum_qty= ceil($rum_qty);
		$rum_buy= sprintf('%12s %-11s  ',
				  "** $rum_qty","$kinds[$best] **");
		$rum_bill= $rum_qty * $price[$best];
	    } else {
		$rum_buy= '   (rum unavailable)';
		$ok= 0;
	    }
	}
	if ($shot_need > 0) {
	    if (valid($price[3])) {
		$shot_buy= sprintf('%7s shot **', "** $shot_need");
		$shot_bill= $shot_need * $price[3];
	    } else {
		$shot_buy= '  (shot unavailable)';
		$ok= 0;
	    }
	}
	if (length($rum_buy) or length($shot_buy)) {
	    pr2($ok
		? sprintf('for a total of %d poe', $rum_bill + $shot_bill)
		: 'for',
		$rum_bill ? sprintf("%12d poe       ", $rum_bill) : '',
		$shot_bill ? sprintf("%10d poe", $shot_bill) : '');
	    pr2('BUY', $rum_buy, $shot_buy);
	} else {
	    print "stocks are sufficient.\n";
	}
	print "\n";
    }
}

parse_args();
print_inputs();
compute_cheapest_rum();
compute_stock_values();
compute_restock_requirements();

STDOUT->error and die $!;
close STDOUT or die $!;