8 .../ypp-restock-rum [<information> ...]
10 where <information> is
12 have [<swill> <grog>] <fine> [<hold_shot>+<loaded_shot>]
13 want [<swill> <grog>] <fine> [<shot>]
14 price <swill> <grog> <fine> [<shot>]
16 Each of which may appear only once, except \`have' which may appear
17 more than once which case we calculate the differences and the profit
20 If <shot> is not specified at all, relevant information about shot is
21 not reported. For have and want, missing entries count as zero.
23 In price, \`x' means the commodity is unavailable.
27 our (@kinds) = qw(Swill Grog Fine Shot);
28 our (@proofs) = qw(40 60 100);
30 sub parse_info ($$$\@$) {
31 my ($omitswgok,$default,$multishot, $storeary, $what) = @_;
32 @ARGV or badusage("missing value for information argument \`$_'");
33 badusage("$what: specified more than once")
34 if defined $storeary->[2];
36 while (@ARGV and $ARGV[0] =~ m/^\d|^x$/) {
41 badusage("$what: swill and grog amounts must be specified")
43 @v=($default,$default,@v);
45 if ($multishot and @v==4 and length $v[3]) {
46 $v[3] =~ m/^0*(\d+)\+0*(\d+)$/ or
47 badusage("$what: shot must be specified as <hold>+<loaded>");
54 badusage("$what: invalid syntax (wrong number of parameters)");
58 if ($default>0 and m/^x$/) {
60 } elsif (m/^0*(\d+)$/) {
63 badusage("$what: $kinds[$i] \`$_': bad syntax");
70 our (@have,@want,@price);
73 @ARGV or badusage("need some information to go on");
77 parse_info(1,0,1, @{ $have[@have] }, 'have');
79 parse_info(1,0,0, @want, 'want');
80 } elsif (m/^price$/) {
81 parse_info(0,1e7,0, @price, 'price');
83 badusage("unknown information argument \`$_'");
90 print STDERR "\nbad usage: $m\n\n$usage\n";
98 defined $x and $x and $x<1e5;
102 my ($what, $format, $ary, $unit) = @_;
103 printf("%-25s", "$what:");
104 for my $i (qw(0 1 2 3)) {
106 my $y= valid($x) ? sprintf $format, $x : ' ';
109 printf " %s\n", $unit;
113 my ($what, $ary, $unit) = @_;
114 prvff($what, '%4d ', @$ary, $unit);
118 my ($what, $ary, $unit) = @_;
119 prvff($what, $ff, @$ary, $unit);
124 printf "%-20s %s\n", "$k:", $v;
126 sub fmt_stock_index ($) {
128 @have==1 ? '' : ' #'.$si;
134 foreach my $i (qw(0 1 2)) {
135 $total += $rums->[$i] * $proofs[$i] / 100;
141 our ($best, $best_norm_price);
143 sub print_inputs () {
145 map { printf " %5s ", $_ } @kinds;
147 pr('prices', @price, 'poe ea.') if valid(@price);
148 pr('target stocks', @want, 'units') if valid(@want);
149 my $si=0; for my $stocks (@have) {
150 pr('actual stocks'.fmt_stock_index(++$si),
156 sub compute_cheapest_rum() {
157 return unless @price;
159 my (@perorder) = map { $_*10 } @price;
160 prf('equiv. ordering price', @perorder, 'poe/order');
163 $best_norm_price= 1e6;
164 for my $i (qw(0 1 2)) {
165 next unless $price[$i];
166 $norm_price[$i] = $price[$i] * 100 / $proofs[$i];
167 if ($norm_price[$i] <= $best_norm_price) {
169 $best_norm_price= $norm_price[$i];
172 prf('normalised prices', @norm_price, 'poe/fine');
175 printf "best is %-10s%*s^^\n",
178 my (@bestperorder) = map {
179 $best_norm_price * $proofs[$_] / 100 * 10;
181 #push @bestperorder, $perorder[3];
182 prf('best is equiv. ordering', @bestperorder, 'poe/order');
196 sub compute_stock_values() {
198 print @have>1 ? <<END
200 _____Rum_____ ___Shot___ total _____Profit___
201 fine equiv. value qty value value per leg total
204 Rum Rum Shot Shot total
205 equiv. value stocks value value
211 my $si=0; for my $stocks (@have) {
212 my $stock_rum = rum_total(@$stocks);
213 my $rum_value= defined($best) ? $stock_rum * $best_norm_price : 0;
214 my $shot_value= valid($price[3]) ? $stocks->[3] * $price[3] : 0;
215 my $total_value= $rum_value + $shot_value;
217 printf "%-10s ", 'stocks'.fmt_stock_index(++$si).':';
218 print ' ' if @have==1;
221 print ' ' if @have==1;
222 printf "%6s", $stocks->[3] ? $stocks->[3] : '';
226 if (defined $last_value) {
227 printf(" %10.1f %10.1f",
228 $total_value - $last_value,
229 $total_value - $initial_value);
231 $initial_value= $total_value unless defined $initial_value;
232 $last_value= $total_value;
235 print "\n" if @have>1;
240 my ($k,$v1,$v2) = @_;
241 printf "%-25s %-23s %s\n", "$k:", $v1, $v2;
245 my ($k,$rum,$shot) = @_;
247 valid($rum) ? sprintf("%12.1f fine equiv", $rum) : '',
248 valid($shot) ? sprintf("%10d shot", $shot) : '');
251 sub compute_restock_requirements () {
254 my $rum_want= rum_total(@want);
256 my $stocks= @have ? $have[-1] : [qw(0 0 0 0)];
257 my $rum_have= rum_total(@$stocks);
259 pr2rs('desired stock level', $rum_want, $want[3]);
261 my $rum_need = $rum_want - $rum_have;
262 my $shot_need = $want[3] - $stocks->[3];
265 pr2rs('current stock', $rum_have, $stocks->[3]);
266 pr2rs('restock requirement', $rum_need, $shot_need);
271 my ($rum_buy,$shot_buy) = ('','');
272 my ($rum_bill,$shot_bill) = qw(0 0);
276 my $rum_qty= $rum_need * 100 / $proofs[$best];
277 $rum_qty= ceil($rum_qty);
278 $rum_buy= sprintf('%12s %-11s ',
279 "** $rum_qty","$kinds[$best] **");
280 $rum_bill= $rum_qty * $price[$best];
282 $rum_buy= ' (rum unavailable)';
286 if ($shot_need > 0) {
287 if (valid($price[3])) {
288 $shot_buy= sprintf('%7s shot **', "** $shot_need");
289 $shot_bill= $shot_need * $price[3];
291 $shot_buy= ' (shot unavailable)';
295 if (length($rum_buy) or length($shot_buy)) {
297 ? sprintf('for a total of %d poe', $rum_bill + $shot_bill)
299 $rum_bill ? sprintf("%12d poe ", $rum_bill) : '',
300 $shot_bill ? sprintf("%10d poe", $shot_bill) : '');
301 pr2('BUY', $rum_buy, $shot_buy);
303 print "stocks are sufficient.\n";
311 compute_cheapest_rum();
312 compute_stock_values();
313 compute_restock_requirements();
315 STDOUT->error and die $!;
316 close STDOUT or die $!;