chiark / gitweb /
git URLs for various source trees
[ypp-sc-tools.db-live.git] / yarrg / web / enter_route
1 <%doc>
2
3  This is part of the YARRG website.  YARRG is a tool and website
4  for assisting players of Yohoho Puzzle Pirates.
5
6  Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
7  Copyright (C) 2009 Clare Boothby
8
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
12    download the source.
13
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.
18
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.
23
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/>.
26
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.
30
31
32  This Mason component generates form contents for selecting a list
33  of locations (eg, a route).
34
35
36 </%doc>
37 <%args>
38 $qa
39 $dbh
40 $emsg_r
41 $warningfs_r
42
43 $enterwhat
44 $islandids_r
45 $archipelagoes_r
46 </%args>
47
48 %#---------- textbox, user enters route as string ----------
49 % if (!$qa->{Dropdowns}) {
50
51 <% $enterwhat %>
52 % if (defined($archipelagoes_r)) {
53 (islands, or archipelagoes,
54 % } else {
55 (islands
56 % }
57 separated by |s or commas; abbreviations are OK):<br>
58
59 <& qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r,
60     thingstring => defined($archipelagoes_r) ? 'routestring' : 'islandstring',
61     prefix => 'rl', boxopts => 'size=80',
62     onresults => sub {
63         foreach (@_) {
64         my ($canonname, $island, $arch) = @$_;
65                 push @$islandids_r, $island;
66                 push @$archipelagoes_r, defined $island ? undef : $arch
67                         if defined $archipelagoes_r;
68         }
69     }
70  &>
71
72 % } else { #---------- dropdowns, user selects from menus ----------
73
74 <%perl>
75 my %islandid2;
76 my ($sth,$row);
77 my @archlistdata;
78 my %islandlistdata;
79 $islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
80
81 my $optionlistmap= sub {
82         my ($optlist, $selected) = @_;
83         my $out='';
84         foreach my $entry (@$optlist) {
85                 $out.= sprintf('<option value="%s" %s>%s</option>',
86                         encode_entities($entry->[0]),
87                         defined $selected && $entry->[0] eq $selected
88                                 ? 'selected' : '',
89                         encode_entities($entry->[1]));
90         }
91         return $out;
92 };
93
94 $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
95                             ORDER BY archipelago;");
96 $sth->execute();
97
98 while ($row=$sth->fetchrow_arrayref) {
99         my ($arch)= @$row;
100         push @archlistdata, [ $arch, $arch ];
101         $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
102 }
103
104 $sth= $dbh->prepare("SELECT islandid,islandname,archipelago
105                             FROM islands
106                             ORDER BY islandname;");
107 $sth->execute();
108
109 while ($row=$sth->fetchrow_arrayref) {
110         my $arch= $row->[2];
111         push @{ $islandlistdata{'none'} }, [ @$row ];
112         push @{ $islandlistdata{$arch} }, [ @$row ];
113         $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
114 }
115
116 my %resetislandlistdata;
117 foreach my $arch (keys %islandlistdata) {
118         $resetislandlistdata{$arch}=
119                 $optionlistmap->($islandlistdata{$arch}, '');
120 }
121
122 </%perl>
123
124 <&| script &>
125 ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
126 function ms_Setarch(dd) {
127   debug('ms_SetArch '+dd+' arch='+arch);
128   var arch= document.getElementsByName('archipelago'+dd).item(0).value;
129   var got= ms_lists[arch];
130   if (got == undefined) return; // unknown arch ?  hrm
131   debug('ms_SetArch '+dd+' arch='+arch+' got ok');
132   var select= document.getElementsByName('islandid'+dd).item(0);
133   select.innerHTML= got;
134   debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
135 }
136 </&script>
137
138 <table style="table-layout:fixed; width:90%;">
139
140 <tr>
141 %       for my $dd (0..$qa->{Dropdowns}-1) {
142 <td>
143 <select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
144 <option value="none">Whole ocean</option>
145 <% $optionlistmap->(\@archlistdata, $qa->{"archipelago$dd"}) %></select></td>
146 %       }
147 </tr>
148
149 <tr>
150 %       for my $dd (0..$qa->{Dropdowns}-1) {
151 %               my $arch= $qa->{"archipelago$dd"};
152 %               $arch= 'none' if !defined $arch;
153 <td>
154 <select name="islandid<% $dd %>">
155 <% $optionlistmap->($islandlistdata{$arch}, $qa->{"islandid$dd"}) %>
156 </select></td>
157 %       }
158 </tr>
159
160 </table>
161
162 <%perl>
163
164 my $argorundef= sub {
165         my ($dd,$base) = @_;
166         my $thing= $qa->{"${base}${dd}"};
167         $thing= undef if defined $thing and $thing eq 'none';
168         return $thing;
169 };
170
171 for my $dd (0..$qa->{Dropdowns}-1) {
172         my $arch= $argorundef->($dd,'archipelago');
173         my $island= $argorundef->($dd,'islandid');
174         next unless defined $arch or defined $island;
175         if (defined $island and defined $arch) {
176                 my $ii= $islandid2{$island};
177                 my $iarch= $ii->{Arch};
178                 if ($iarch ne $arch) {
179                         push @$warningfs_r, sub {
180 </%perl>
181  Specified archipelago <% $arch %> but
182  island <% $ii->{Name} %>
183  which is in <% $iarch %>; using the island.<p>
184 <%perl>
185                         };
186                 }
187                 $arch= undef;
188         }
189         push @$archipelagoes_r, $arch;
190         push @$islandids_r, $island;
191 }
192
193 </%perl>
194 <p>
195
196 % }