3 This is part of the YARRG website. YARRG is a tool and website
4 for assisting players of Yohoho Puzzle Pirates.
6 Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
7 Copyright (C) 2009 Clare Boothby
9 YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
10 The YARRG website is covered by the GNU Affero GPL v3 or later, which
11 basically means that every installation of the website will let you
14 This program is free software: you can redistribute it and/or modify
15 it under the terms of the GNU Affero General Public License as
16 published by the Free Software Foundation, either version 3 of the
17 License, or (at your option) any later version.
19 This program is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU Affero General Public License for more details.
24 You should have received a copy of the GNU Affero General Public License
25 along with this program. If not, see <http://www.gnu.org/licenses/>.
27 Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
28 are used without permission. This program is not endorsed or
29 sponsored by Three Rings.
32 This Mason component simply defines how to interpret capacities.
46 my $parse_numeric= sub {
47 # returns (mass,volume,emsg)
48 my ($string,$default)= @_;
50 my @mve= (undef,undef,undef);
52 if ($string !~ m/\d/) {
54 'Adjustments to capacity must contain digits.');
58 my ($ix,$what,$val) = @_;
59 if (defined $h->{$what}) {
60 $mve[2]= "\`$string' specifies $what more than once.";
62 print STDERR "SET $what $val\n";
66 print STDERR "PAN \`$string'\n";
68 foreach $_ (split /\s+/, $string) {
69 print STDERR "ITEM \`$_'\n";
71 if (m/^([1-9]\d{0,8})l$/) {
72 $def->(1, 'volume', $1);
73 } elsif (m/^([1-9]\d{0,8})kg$/) {
74 $def->(0, 'mass', $1);
75 } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)kl/) {
76 $def->(1, 'volume', $1 * 1000);
77 } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)t/) {
78 $def->(0, 'mass', $1 * 1000);
80 $mve[2]= "Cannot understand item \`$_'".
81 " in numeric capacity";
84 # foreach my $ix (qw(0 1)) {
85 # $mve[$ix]= $default unless defined $mve[$ix];
91 print STDERR "NDELTA0 $#{ $h->{'deltas'} }\n";
93 local ($_)= ${ $h->{String} };
94 while (m/^(.*)(\bminus\b|-|\bplus\b|\+)/) {
95 my ($lhs,$rhs)= ($1,$');
96 print STDERR "TERM L=\`$1' M=\`$2' R=\`$''\n";
97 my ($signum,$signopstr)=
98 $2 =~ m/^p|^\+/ ? (+1,'plus') : (-1,'minus');
99 my (@mve)= $parse_numeric->($rhs, 0);
100 ${ $h->{Emsg} }= $mve[2] if defined $mve[2];
101 unshift @{ $h->{'deltas'} }, [ @mve,$signum,$signopstr ];
102 print STDERR "NDELTA $#{ $h->{'deltas'} }\n";
109 push @{ $h->{Specs} }, $_;
111 my (@mve)= $parse_numeric->($_, undef);
112 if (defined $mve[2]) { ${ $h->{Emsg} }= $mve[2]; return; }
113 $h->{'initial'}= \@mve;
115 ${ $h->{Emsg} }= "Cannot understand capacity specification \`$_'.";
117 $h->{'initial'}= [undef,undef];
124 SELECT name,mass,volume
125 FROM vessels WHERE name LIKE ?
129 Did not understand ship name.
133 Ambiguous - could be <% $ARGS{couldbe} |h %>
137 Too many matching ship types.
146 return if length ${ $h->{Emsg} };
148 my @mv_names= qw(mass volume);
150 my $canon_numeric= sub {
151 print STDERR "CANNUM @_\n";
154 foreach my $ix (qw(0 1)) {
155 next unless defined $_[$ix];
156 $out .= $sep; $sep= ' ';
157 $out .= sprintf "%g%s", $_[$ix], (qw(kg l))[$ix];
163 if (@{ $h->{Specs} }) {
164 @mv= @{ $h->{Results}[0] }[1,2];
165 print STDERR "INITIAL VESSEL @mv\n";
167 @mv= @{ $h->{'initial'} };
168 ${ $h->{Canon} }= $canon_numeric->(@mv);
171 print STDERR "NDELTAE $#{ $h->{'deltas'} }\n";
172 foreach my $delta (@{ $h->{'deltas'} }) {
173 print STDERR "DELTA @$delta\n";
174 die if defined $delta->[2]; # emsg
175 foreach my $ix (qw(0 1)) {
176 next unless defined $delta->[$ix];
177 print STDERR "DELTA I $ix\n";
178 if (!defined $mv[$ix]) {
179 ${ $h->{Emsg} }= "Cannot add or subtract".
180 " $mv_names[$ix] to/from $mv_names[!$ix]";
183 $mv[$ix] += $delta->[$ix] * $delta->[3];
185 ${ $h->{Canon} }.= " $delta->[4] ". $canon_numeric->(@$delta);
188 if (@{ $h->{Specs} } || @{ $h->{'deltas'} }) {
189 ${ $h->{Canon} }.= " [= ". $canon_numeric->(@mv). "]";
192 foreach my $ix (qw(0 1)) {
193 next unless defined $mv[$ix];
194 next if $mv[$ix] >= 0;
195 ${ $h->{Emsg} }= sprintf "%s limit is negative: %s",
196 ucfirst($mv_names[$ix]), $canon_numeric->(@mv);
200 @{ $h->{Results} }= [ @mv ];