#!/usr/bin/perl -w
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 () {
    @ARGV or 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 $!;