chiark / gitweb /
Add "celtic" as E
[ypp-sc-tools.db-live.git] / 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 $!;