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 financial implications
20 Missing entries count as zero (and zeroes are not displayed in the output).
21 In price, \`x' means the commodity is unavailable.
23 The intended use is that at the start of the pillage you run:
24 ypp-restock-rum have ... want ...
25 to check that stocks are sufficient, or perhaps:
26 ypp-restock-rum have ... want ... price ...
27 if you want to stock up some more. At the end of the pillage,
28 run the same thing again with some extra parameters:
29 ypp-restock-rum have .. want ... have ... price ...
30 and it will tell you how you did and what the restock should be like.
34 our (@kinds) = qw(Swill Grog Fine Shot);
35 our (@proofs) = qw(40 60 100);
37 sub parse_info ($$$\@$) {
38 my ($omitswgok,$default,$multishot, $storeary, $what) = @_;
39 @ARGV or badusage("missing value for information argument \`$_'");
40 badusage("$what: specified more than once")
41 if defined $storeary->[2];
43 while (@ARGV and $ARGV[0] =~ m/^\d|^x$/) {
48 badusage("$what: swill and grog amounts must be specified")
50 @v=($default,$default,@v);
52 if ($multishot and @v==4 and length $v[3]) {
53 $v[3] =~ m/^0*(\d+)\+0*(\d+)$/ or
54 badusage("$what: shot must be specified as <hold>+<loaded>");
61 badusage("$what: invalid syntax (wrong number of parameters)");
65 if ($default>0 and m/^x$/) {
67 } elsif (m/^0*(\d+)$/) {
70 badusage("$what: $kinds[$i] \`$_': bad syntax");
77 our (@have,@want,@price);
80 @ARGV or badusage("need some information to go on");
84 parse_info(1,0,1, @{ $have[@have] }, 'have');
86 parse_info(1,0,0, @want, 'want');
87 } elsif (m/^price$/) {
88 parse_info(0,1e7,0, @price, 'price');
90 badusage("unknown information argument \`$_'");
97 print STDERR "\nbad usage: $m\n\n$usage\n";
105 defined $x and $x and $x<1e5;
109 my ($what, $format, $ary, $unit) = @_;
110 printf("%-25s", "$what:");
111 for my $i (qw(0 1 2 3)) {
113 my $y= valid($x) ? sprintf $format, $x : ' ';
116 printf " %s\n", $unit;
120 my ($what, $ary, $unit) = @_;
121 prvff($what, '%4d ', @$ary, $unit);
125 my ($what, $ary, $unit) = @_;
126 prvff($what, $ff, @$ary, $unit);
131 printf "%-20s %s\n", "$k:", $v;
133 sub fmt_stock_index ($) {
135 @have==1 ? '' : ' #'.$si;
141 foreach my $i (qw(0 1 2)) {
142 $total += $rums->[$i] * $proofs[$i] / 100;
148 our ($best, $best_norm_price);
150 sub print_inputs () {
152 map { printf " %5s ", $_ } @kinds;
154 pr('prices', @price, 'poe ea.') if valid(@price);
155 pr('target stocks', @want, 'units') if valid(@want);
156 my $si=0; for my $stocks (@have) {
157 pr('actual stocks'.fmt_stock_index(++$si),
163 sub compute_cheapest_rum() {
164 return unless @price;
166 my (@perorder) = map { $_*10 } @price;
167 prf('equiv. ordering price', @perorder, 'poe/order');
170 $best_norm_price= 1e6;
171 for my $i (qw(0 1 2)) {
172 next unless $price[$i];
173 $norm_price[$i] = $price[$i] * 100 / $proofs[$i];
174 if ($norm_price[$i] <= $best_norm_price) {
176 $best_norm_price= $norm_price[$i];
179 prf('normalised prices', @norm_price, 'poe/fine');
182 printf "best is %-10s%*s^^\n",
185 my (@bestperorder) = map {
186 $best_norm_price * $proofs[$_] / 100 * 10;
188 #push @bestperorder, $perorder[3];
189 prf('best is equiv. ordering', @bestperorder, 'poe/order');
203 sub compute_stock_values() {
205 print @have>1 ? <<END
207 _____Rum_____ ___Shot___ total _____Profit___
208 fine equiv. value qty value value per leg total
211 Rum Rum Shot Shot total
212 equiv. value stocks value value
218 my $si=0; for my $stocks (@have) {
219 my $stock_rum = rum_total(@$stocks);
220 my $rum_value= defined($best) ? $stock_rum * $best_norm_price : 0;
221 my $shot_value= valid($price[3]) ? $stocks->[3] * $price[3] : 0;
222 my $total_value= $rum_value + $shot_value;
224 printf "%-10s ", 'stocks'.fmt_stock_index(++$si).':';
225 print ' ' if @have==1;
228 print ' ' if @have==1;
229 printf "%6s", $stocks->[3] ? $stocks->[3] : '';
233 if (defined $last_value) {
234 printf(" %10.1f %10.1f",
235 $total_value - $last_value,
236 $total_value - $initial_value);
238 $initial_value= $total_value unless defined $initial_value;
239 $last_value= $total_value;
242 print "\n" if @have>1;
247 my ($k,$v1,$v2) = @_;
248 printf "%-25s %-23s %s\n", "$k:", $v1, $v2;
252 my ($k,$rum,$shot) = @_;
254 valid($rum) ? sprintf("%12.1f fine equiv", $rum) : '',
255 valid($shot) ? sprintf("%10d shot", $shot) : '');
258 sub compute_restock_requirements () {
261 my $rum_want= rum_total(@want);
263 my $stocks= @have ? $have[-1] : [qw(0 0 0 0)];
264 my $rum_have= rum_total(@$stocks);
266 pr2rs('desired stock level', $rum_want, $want[3]);
268 my $rum_need = $rum_want - $rum_have;
269 my $shot_need = $want[3] - $stocks->[3];
272 pr2rs('current stock', $rum_have, $stocks->[3]);
273 pr2rs('restock requirement', $rum_need, $shot_need);
278 my ($rum_buy,$shot_buy) = ('','');
279 my ($rum_bill,$shot_bill) = qw(0 0);
283 my $rum_qty= $rum_need * 100 / $proofs[$best];
284 $rum_qty= ceil($rum_qty);
285 $rum_buy= sprintf('%12s %-11s ',
286 "** $rum_qty","$kinds[$best] **");
287 $rum_bill= $rum_qty * $price[$best];
289 $rum_buy= ' (rum unavailable)';
293 if ($shot_need > 0) {
294 if (valid($price[3])) {
295 $shot_buy= sprintf('%7s shot **', "** $shot_need");
296 $shot_bill= $shot_need * $price[3];
298 $shot_buy= ' (shot unavailable)';
302 if (length($rum_buy) or length($shot_buy)) {
304 ? sprintf('for a total of %d poe', $rum_bill + $shot_bill)
306 $rum_bill ? sprintf("%12d poe ", $rum_bill) : '',
307 $shot_bill ? sprintf("%10d poe", $shot_bill) : '');
308 pr2('BUY', $rum_buy, $shot_buy);
310 print "stocks are sufficient.\n";
318 compute_cheapest_rum();
319 compute_stock_values();
320 compute_restock_requirements();
322 STDOUT->error and die $!;
323 close STDOUT or die $!;