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 generates the core of the `trade route' query.
41 $capacitystring => '';
52 my ($max_volume, $max_mass);
61 <form action="<% $quri->() |h %>" method="<% $be_post ? 'post' : 'get' %>">
64 my $goupdate= sub { $be_post ? 'Update' : 'Go' };
68 <h1>Specify route</h1>
70 % $prselector->('ShowStalls');
72 %#---------- textbox, user enters route as string ----------
73 % if (!$qa->{Dropdowns}) {
75 Enter route (islands, or archipelagoes, separated by |s or commas;
76 abbreviations are OK):<br>
78 % $startform->($routestring =~ m/\S/);
80 <&| qtextstring, qa => $qa, dbh => $dbh,
81 thingstring => 'routestring', emsgstore => \$emsg,
83 my ($canonname, $island, $arch) = @_;
84 push @islandids, $island;
85 push @archipelagoes, defined $island ? undef : $arch;
96 <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs',
97 thingstring => 'capacitystring', emsgstore => \$emsg,
99 ($max_volume,$max_mass) = @_;
109 Estimated loss per league:
111 <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'll',
112 thingstring => 'lossperleague', emsgstore => \$emsg,
113 perresult => sub { ($lossperleaguepct)= @_; }
119 % } else { #---------- dropdowns, user selects from menus ----------
121 % $startform->(grep {
122 % defined $ARGS{"archipelago$_"} ||
123 % defined $ARGS{"islandid$_"}
124 % } (0..$qa->{Dropdowns}-1));
130 $islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
132 my $optionlistmap= sub {
133 my ($optlist, $selected) = @_;
135 foreach my $entry (@$optlist) {
136 $out.= sprintf('<option value="%s" %s>%s</option>',
137 encode_entities($entry->[0]),
138 defined $selected && $entry->[0] eq $selected
140 encode_entities($entry->[1]));
145 $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
146 ORDER BY archipelago;");
149 while ($row=$sth->fetchrow_arrayref) {
151 push @archlistdata, [ $arch, $arch ];
152 $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
155 $sth= $dbh->prepare("SELECT islandid,islandname,archipelago
157 ORDER BY islandname;");
160 while ($row=$sth->fetchrow_arrayref) {
162 push @{ $islandlistdata{'none'} }, [ @$row ];
163 push @{ $islandlistdata{$arch} }, [ @$row ];
164 $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
167 my %resetislandlistdata;
168 foreach my $arch (keys %islandlistdata) {
169 $resetislandlistdata{$arch}=
170 $optionlistmap->($islandlistdata{$arch}, '');
176 ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
177 function ms_Setarch(dd) {
178 debug('ms_SetArch '+dd+' arch='+arch);
179 var arch= document.getElementsByName('archipelago'+dd).item(0).value;
180 var got= ms_lists[arch];
181 if (got == undefined) return; // unknown arch ? hrm
182 debug('ms_SetArch '+dd+' arch='+arch+' got ok');
183 var select= document.getElementsByName('islandid'+dd).item(0);
184 select.innerHTML= got;
185 debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
189 <table style="table-layout:fixed; width:90%;">
192 % for my $dd (0..$qa->{Dropdowns}-1) {
194 <select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
195 <option value="none">Whole ocean</option>
196 <% $optionlistmap->(\@archlistdata, $ARGS{"archipelago$dd"}) %></select></td>
201 % for my $dd (0..$qa->{Dropdowns}-1) {
202 % my $arch= $ARGS{"archipelago$dd"};
203 % $arch= 'none' if !defined $arch;
205 <select name="islandid<% $dd %>">
206 <% $optionlistmap->($islandlistdata{$arch}, $ARGS{"islandid$dd"}) %>
213 % } #---------- end of dropdowns, now common middle of page code ----------
215 <input type=submit name=submit value="<% $goupdate->() %>">
216 % my $ours= sub { $_[0] =~
217 % m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^[RT]/;
219 <& "lookup:formhidden", ours => $ours &>
222 #========== results ==========
224 $emsgokorprint->($emsg) or @islandids=();
226 my $argorundef= sub {
228 my $thing= $ARGS{"${base}${dd}"};
229 $thing= undef if defined $thing and $thing eq 'none';
233 for my $dd (0..$qa->{Dropdowns}-1) {
234 my $arch= $argorundef->($dd,'archipelago');
235 my $island= $argorundef->($dd,'islandid');
236 next unless defined $arch or defined $island;
237 if (defined $island and defined $arch) {
238 my $ii= $islandid2{$island};
239 my $iarch= $ii->{Arch};
240 if ($iarch ne $arch) {
243 Specified archipelago <% $arch %> but
244 island <% $ii->{Name} %>
245 which is in <% $iarch %>; using the island.<br>
250 push @archipelagoes, $arch;
251 push @islandids, $island;
257 % $someresults->('Relevant trades');
260 islandids => \@islandids,
261 archipelagoes => \@archipelagoes,
263 max_mass => $max_mass,
264 max_volume => $max_volume,
265 lossperleaguepct => $lossperleaguepct