ypp-restock-rum

   1 #!/usr/bin/perl -w
   2 # This is part of ypp-sc-tools, a set of third-party tools for assisting
   3 # players of Yohoho Puzzle Pirates.
   4 #
   5 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
   6 #
   7 # This program is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation, either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19 #
  20 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  21 # are used without permission.  This program is not endorsed or
  22 # sponsored by Three Rings.
  23
  24 use strict qw(vars);
  25 use IO::Handle;
  26 use POSIX;
  27
  28 my $usage = <<END
  29 usage:
  30   .../ypp-restock-rum [<information> ...]
  31
  32 where <information> is
  33
  34   have  [<swill> <grog>] <fine> [<hold_shot>+<loaded_shot>]
  35   want  [<swill> <grog>] <fine> [<shot>]
  36   price  <swill> <grog>  <fine> [<shot>]
  37
  38 Each of which may appear only once, except \`have' which may appear
  39 more than once which case we calculate the financial implications
  40 at each stage.
  41
  42 Missing entries count as zero (and zeroes are not displayed in the output).
  43 In price, \`x' means the commodity is unavailable.
  44
  45 The intended use is that at the start of the pillage you run:
  46    ypp-restock-rum have ... want ...
  47 to check that stocks are sufficient, or perhaps:
  48    ypp-restock-rum have ... want ... price ...
  49 if you want to stock up some more.  At the end of the pillage,
  50 run the same thing again with some extra parameters:
  51    ypp-restock-rum have .. want ... have ... price ...
  52 and it will tell you how you did and what the restock should be like.
  53 END
  54 ;
  55
  56 our (@kinds) = qw(Swill Grog Fine Shot);
  57 our (@proofs) = qw(40 60 100);
  58
  59 sub parse_info ($$$\@$) {
  60     my ($omitswgok,$default,$multishot, $storeary, $what) = @_;
  61     @ARGV or badusage("missing value for information argument \`$_'");
  62     badusage("$what: specified more than once")
  63         if defined $storeary->[2];
  64     my (@v) = ();
  65     while (@ARGV and $ARGV[0] =~ m/^\d|^x$/) {
  66         $_ = shift @ARGV;
  67         push @v, $_;
  68     }
  69     if (@v==1 or @v==2) {
  70         badusage("$what: swill and grog amounts must be specified")
  71             unless $omitswgok;
  72         @v=($default,$default,@v);
  73     }
  74     if ($multishot and @v==4 and length $v[3]) {
  75         $v[3] =~ m/^0*(\d+)\+0*(\d+)$/ or
  76             badusage("$what: shot must be specified as <hold>+<loaded>");
  77         $v[3] = $1 + $2;
  78     }
  79     if (@v==3) {
  80         push @v, $default;
  81     }
  82     if (@v != 4) {
  83         badusage("$what: invalid syntax (wrong number of parameters)");
  84     }
  85     my $i=0;
  86     foreach $_ (@v) {
  87         if ($default>0 and m/^x$/) {
  88             $_ = $default;
  89         } elsif (m/^0*(\d+)$/) {
  90             $_= $1;
  91         } else {
  92             badusage("$what: $kinds[$i] \`$_': bad syntax");
  93         }
  94         $i++;
  95     }
  96     @$storeary = @v;
  97 }
  98
  99 our (@have,@want,@price);
 100
 101 sub parse_args () {
 102     if (!@ARGV) {
 103         print STDERR <<END or die $!;
 104
 105 ypp-restock-rum is part of ypp-sc-tools  Copyright (C) 2009 Ian Jackson
 106 This program comes with ABSOLUTELY NO WARRANTY; this is free software,
 107 and you are welcome to redistribute it under certain conditions.
 108 For details, read the top of the ypp-restock-rum file.
 109 END
 110         badusage("need some information to go on");
 111     }
 112     while (@ARGV) {
 113         $_ = shift @ARGV;
 114         if (m/^have$/) {
 115             parse_info(1,0,1, @{ $have[@have] }, 'have');
 116         } elsif (m/^want$/) {
 117             parse_info(1,0,0, @want, 'want');
 118         } elsif (m/^prices?$|^costs?$/) {
 119             parse_info(0,1e7,0, @price, 'price');
 120         } else {
 121             badusage("unknown information argument \`$_'");
 122         }
 123     }
 124 }
 125
 126 sub badusage ($) {
 127     my ($m) = @_;
 128     print STDERR "\nbad usage: $m\n\n$usage\n";
 129     exit 16;
 130 }
 131
 132 our $ff = '%6.1f';
 133
 134 sub valid ($) {
 135     my ($x) = @_;
 136     defined $x and $x and $x<1e5;
 137 }
 138
 139 sub prvff ($$\@$) {
 140     my ($what, $format, $ary, $unit) = @_;
 141     printf("%-25s", "$what:");
 142     for my $i (qw(0 1 2 3)) {
 143         my $x= $ary->[$i];
 144         my $y= valid($x) ? sprintf $format, $x : '    ';
 145         printf " %-9s", $y;
 146     }
 147     printf "  %s\n", $unit;
 148 }
 149
 150 sub pr ($\@$) {
 151     my ($what, $ary, $unit) = @_;
 152     prvff($what, '%4d  ', @$ary, $unit);
 153 }
 154
 155 sub prf ($\@$) {
 156     my ($what, $ary, $unit) = @_;
 157     prvff($what, $ff, @$ary, $unit);
 158 }
 159
 160 sub pr1 ($$) {
 161     my ($k,$v) = @_;
 162     printf "%-20s %s\n", "$k:", $v;
 163 }
 164 sub fmt_stock_index ($) {
 165     my ($si) = @_;
 166     @have==1 ? '' : ' #'.$si;
 167 }
 168
 169 sub rum_total (\@) {
 170     my ($rums) = @_;
 171     my $total= 0;
 172     foreach my $i (qw(0 1 2)) {
 173         $total += $rums->[$i] * $proofs[$i] / 100;
 174     }
 175     return $total;
 176 }
 177
 178 our @norm_price;
 179 our ($best, $best_norm_price);
 180
 181 sub print_inputs () {
 182     printf("%25s",'');
 183     map { printf " %5s    ", $_ } @kinds;
 184     print "\n\n";
 185     pr('prices', @price, 'poe ea.') if valid(@price);
 186     pr('target stocks', @want, 'units') if valid(@want);
 187     my $si=0; for my $stocks (@have) {
 188         pr('actual stocks'.fmt_stock_index(++$si),
 189            @$stocks, 'units');
 190     }
 191     print "\n";
 192 }
 193
 194 sub compute_cheapest_rum() {
 195     return unless @price;
 196
 197     my (@perorder) = map { $_*10 } @price;
 198     prf('equiv. ordering price', @perorder, 'poe/order');
 199
 200     $best= undef;
 201     $best_norm_price= 1e6;
 202     for my $i (qw(0 1 2)) {
 203         next unless $price[$i];
 204         $norm_price[$i] = $price[$i] * 100 / $proofs[$i];
 205         if ($norm_price[$i] <= $best_norm_price) {
 206             $best= $i;
 207             $best_norm_price= $norm_price[$i];
 208         }
 209     };
 210     prf('normalised prices', @norm_price, 'poe/fine');
 211
 212     if (defined $best) {
 213         printf "best is %-10s%*s^^\n",
 214             $kinds[$best],
 215             $best*10+10, '';
 216         my (@bestperorder) = map {
 217             $best_norm_price * $proofs[$_] / 100 * 10;
 218         } qw(0 1 2);
 219         #push @bestperorder, $perorder[3];
 220         prf('best is equiv. ordering', @bestperorder, 'poe/order');
 221     }
 222     print "\n";
 223 }
 224
 225 sub pr1s ($) {
 226     my ($x) = @_;
 227     if (valid($x)) {
 228         printf ' %9.1f', $x;
 229     } else {
 230         printf "          ";
 231     }
 232 }
 233
 234 sub compute_stock_values() {
 235     return unless @have;
 236     print @have>1 ? <<END
 237
 238                 _____Rum_____      ___Shot___      total      _____Profit___
 239              fine equiv.  value   qty    value     value     per leg     total
 240 END
 241 : <<END
 242                              Rum      Rum             Shot    Shot     total
 243                             equiv.   value           stocks   value    value
 244 END
 245 ;
 246
 247     my $initial_value;
 248     my $last_value;
 249     my $si=0; for my $stocks (@have) {
 250         my $stock_rum = rum_total(@$stocks);
 251         my $rum_value= defined($best) ? $stock_rum * $best_norm_price : 0;
 252         my $shot_value= valid($price[3]) ? $stocks->[3] * $price[3] : 0;
 253         my $total_value= $rum_value + $shot_value;
 254
 255         printf "%-10s ", 'stocks'.fmt_stock_index(++$si).':';
 256         print '            ' if @have==1;
 257         pr1s($stock_rum);
 258         pr1s($rum_value);
 259         print '        ' if @have==1;
 260         printf "%6s", $stocks->[3] ? $stocks->[3] : '';
 261         pr1s($shot_value);
 262         pr1s($total_value);
 263
 264         if (defined $last_value) {
 265             printf(" %10.1f %10.1f",
 266                    $total_value - $last_value,
 267                    $total_value - $initial_value);
 268         }
 269         $initial_value= $total_value unless defined $initial_value;
 270         $last_value= $total_value;
 271         print "\n";
 272     }
 273     print "\n" if @have>1;
 274     print "\n";
 275 }
 276
 277 sub pr2 ($$$) {
 278     my ($k,$v1,$v2) = @_;
 279     printf "%-25s %-23s %s\n", "$k:", $v1, $v2;
 280 }
 281
 282 sub pr2rs ($$$) {
 283     my ($k,$rum,$shot) = @_;
 284     pr2($k,
 285         valid($rum) ? sprintf("%12.1f fine equiv", $rum) : '',
 286         valid($shot) ? sprintf("%10d shot", $shot) : '');
 287 }
 288
 289 sub compute_restock_requirements () {
 290     return unless @want;
 291
 292     my $rum_want= rum_total(@want);
 293
 294     my $stocks= @have ? $have[-1] : [qw(0 0 0 0)];
 295     my $rum_have= rum_total(@$stocks);
 296
 297     pr2rs('desired stock level', $rum_want, $want[3]);
 298
 299     my $rum_need = $rum_want - $rum_have;
 300     my $shot_need = $want[3] - $stocks->[3];
 301
 302     if (@have) {
 303         pr2rs('current stock', $rum_have, $stocks->[3]);
 304         pr2rs('restock requirement', $rum_need, $shot_need);
 305         print "\n";
 306     }
 307
 308     if (@price) {
 309         my ($rum_buy,$shot_buy) = ('','');
 310         my ($rum_bill,$shot_bill) = qw(0 0);
 311         my $ok=1;
 312         if ($rum_need > 0) {
 313             if (defined $best) {
 314                 my $rum_qty= $rum_need * 100 / $proofs[$best];
 315                 $rum_qty= ceil($rum_qty);
 316                 $rum_buy= sprintf('%12s %-11s  ',
 317                                   "** $rum_qty","$kinds[$best] **");
 318                 $rum_bill= $rum_qty * $price[$best];
 319             } else {
 320                 $rum_buy= '   (rum unavailable)';
 321                 $ok= 0;
 322             }
 323         }
 324         if ($shot_need > 0) {
 325             if (valid($price[3])) {
 326                 $shot_buy= sprintf('%7s shot **', "** $shot_need");
 327                 $shot_bill= $shot_need * $price[3];
 328             } else {
 329                 $shot_buy= '  (shot unavailable)';
 330                 $ok= 0;
 331             }
 332         }
 333         if (length($rum_buy) or length($shot_buy)) {
 334             pr2($ok
 335                 ? sprintf('for a total of %d poe', $rum_bill + $shot_bill)
 336                 : 'for',
 337                 $rum_bill ? sprintf("%12d poe       ", $rum_bill) : '',
 338                 $shot_bill ? sprintf("%10d poe", $shot_bill) : '');
 339             pr2('BUY', $rum_buy, $shot_buy);
 340         } else {
 341             print "stocks are sufficient.\n";
 342         }
 343         print "\n";
 344     }
 345 }
 346
 347 parse_args();
 348 print_inputs();
 349 compute_cheapest_rum();
 350 compute_stock_values();
 351 compute_restock_requirements();
 352
 353 STDOUT->error and die $!;
 354 close STDOUT or die $!;