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 => '';
51 my ($max_volume, $max_mass);
59 <form action="<% $quri->() |h %>" method="<% $be_post ? 'post' : 'get' %>">
62 my $goupdate= sub { $be_post ? 'Update' : 'Go' };
66 <h1>Specify route</h1>
68 % $prselector->('ShowStalls');
70 %#---------- textbox, user enters route as string ----------
71 % if (!$qa->{Dropdowns}) {
73 Enter route (islands, or archipelagoes, separated by |s or commas;
74 abbreviations are OK):<br>
76 % $startform->($routestring =~ m/\S/);
78 <&| qtextstring, qa => $qa, dbh => $dbh,
79 thingstring => 'routestring', emsgstore => \$emsg,
81 my ($canonname, $island, $arch) = @_;
82 push @islandids, $island;
83 push @archipelagoes, defined $island ? undef : $arch;
90 <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs',
91 thingstring => 'capacitystring', emsgstore => \$emsg,
93 ($max_volume,$max_mass) = @_;
98 % } else { #---------- dropdowns, user selects from menus ----------
100 % $startform->(grep {
101 % defined $ARGS{"archipelago$_"} ||
102 % defined $ARGS{"islandid$_"}
103 % } (0..$qa->{Dropdowns}-1));
109 $islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
111 my $optionlistmap= sub {
112 my ($optlist, $selected) = @_;
114 foreach my $entry (@$optlist) {
115 $out.= sprintf('<option value="%s" %s>%s</option>',
116 encode_entities($entry->[0]),
117 defined $selected && $entry->[0] eq $selected
119 encode_entities($entry->[1]));
124 $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
125 ORDER BY archipelago;");
128 while ($row=$sth->fetchrow_arrayref) {
130 push @archlistdata, [ $arch, $arch ];
131 $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
134 $sth= $dbh->prepare("SELECT islandid,islandname,archipelago
136 ORDER BY islandname;");
139 while ($row=$sth->fetchrow_arrayref) {
141 push @{ $islandlistdata{'none'} }, [ @$row ];
142 push @{ $islandlistdata{$arch} }, [ @$row ];
143 $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
146 my %resetislandlistdata;
147 foreach my $arch (keys %islandlistdata) {
148 $resetislandlistdata{$arch}=
149 $optionlistmap->($islandlistdata{$arch}, '');
155 ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
156 function ms_Setarch(dd) {
157 debug('ms_SetArch '+dd+' arch='+arch);
158 var arch= document.getElementsByName('archipelago'+dd).item(0).value;
159 var got= ms_lists[arch];
160 if (got == undefined) return; // unknown arch ? hrm
161 debug('ms_SetArch '+dd+' arch='+arch+' got ok');
162 var select= document.getElementsByName('islandid'+dd).item(0);
163 select.innerHTML= got;
164 debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
168 <table style="table-layout:fixed; width:90%;">
171 % for my $dd (0..$qa->{Dropdowns}-1) {
173 <select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
174 <option value="none">Whole ocean</option>
175 <% $optionlistmap->(\@archlistdata, $ARGS{"archipelago$dd"}) %></select></td>
180 % for my $dd (0..$qa->{Dropdowns}-1) {
181 % my $arch= $ARGS{"archipelago$dd"};
182 % $arch= 'none' if !defined $arch;
184 <select name="islandid<% $dd %>">
185 <% $optionlistmap->($islandlistdata{$arch}, $ARGS{"islandid$dd"}) %>
192 % } #---------- end of dropdowns, now common middle of page code ----------
194 <input type=submit name=submit value="<% $goupdate->() %>">
195 % my $ours= sub { $_[0] =~
196 % m/^island|^archipelago|^routestring|^capacitystring|^[RT]/;
198 <& "lookup:formhidden", ours => $ours &>
201 #========== results ==========
203 $emsgokorprint->($emsg) or @islandids=();
205 my $argorundef= sub {
207 my $thing= $ARGS{"${base}${dd}"};
208 $thing= undef if defined $thing and $thing eq 'none';
212 for my $dd (0..$qa->{Dropdowns}-1) {
213 my $arch= $argorundef->($dd,'archipelago');
214 my $island= $argorundef->($dd,'islandid');
215 next unless defined $arch or defined $island;
216 if (defined $island and defined $arch) {
217 my $ii= $islandid2{$island};
218 my $iarch= $ii->{Arch};
219 if ($iarch ne $arch) {
222 Specified archipelago <% $arch %> but
223 island <% $ii->{Name} %>
224 which is in <% $iarch %>; using the island.<br>
229 push @archipelagoes, $arch;
230 push @islandids, $island;
236 % $someresults->('Relevant trades');
239 islandids => \@islandids,
240 archipelagoes => \@archipelagoes,
242 max_mass => $max_mass,
243 max_volume => $max_volume