X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2Fweb%2Fquery_route;h=296c0126f8989fb1a22c897605e197944a1771d0;hp=4344e1d017d69b1c5113bf70b446e82e78befbad;hb=742ec1631db983f22545c9c7d6d573865bdc85fa;hpb=aed32e2dcb952bcfc9678eef4125e269f538edf2 diff --git a/yarrg/web/query_route b/yarrg/web/query_route index 4344e1d..296c012 100644 --- a/yarrg/web/query_route +++ b/yarrg/web/query_route @@ -1,78 +1,134 @@ +<%doc> + + This is part of the YARRG website. YARRG is a tool and website + for assisting players of Yohoho Puzzle Pirates. + + Copyright (C) 2009 Ian Jackson + Copyright (C) 2009 Clare Boothby + + YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later). + The YARRG website is covered by the GNU Affero GPL v3 or later, which + basically means that every installation of the website will let you + download the source. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + + Yohoho and Puzzle Pirates are probably trademarks of Three Rings and + are used without permission. This program is not endorsed or + sponsored by Three Rings. + + + This Mason component generates the core of the `trade route' query. + + + <%args> $quri -$a +$dbh +$prselector $routestring => ''; +$capacitystring => ''; +$lossperleague => ''; +$someresults +$emsgokorprint + <%perl> -#my $routestring= $queryqf{'routestring'}; -# -# for output: +my $emsg; my @archipelagoes; my @islandids; my %islandid2; +my ($max_volume, $max_mass); +my $lossperleaguepct; + +my $qa= \%ARGS; + +my $be_post; +my $startform= sub { + ($be_post)= @_; + +
+<%perl> +}; +my $goupdate= sub { $be_post ? 'Update' : 'Go' };

Specify route

- + +% $prselector->('ShowStalls'); %#---------- textbox, user enters route as string ---------- -% if (!$a->{Dropdowns}) { +% if (!$qa->{Dropdowns}) { Enter route (islands, or archipelagoes, separated by |s or commas; abbreviations are OK):
-<&| script &> -tr_uri= "routetextstring?format=json&type=text/xml" - + "&ocean=<% uri_escape($a->{Ocean}) %>"; - -tr_timeout=false; -tr_request=false; -tr_done=''; -tr_needed=''; -function tr_Later(){ - window.clearTimeout(tr_timeout); - tr_timeout = window.setTimeout(tr_Needed, 500); -} -function tr_Needed(){ - window.clearTimeout(tr_timeout); - tr_element= document.getElementById('routestring'); - tr_needed= tr_element.value; - tr_Request(); -} -function tr_Request(){ - if (tr_request || tr_needed==tr_done) return; - tr_done= tr_needed; - tr_request= new XMLHttpRequest(); - uri= tr_uri+'&string='+encodeURIComponent(tr_needed); - tr_request.open('GET', uri); - tr_request.onreadystatechange= tr_Ready; - tr_request.send(null); -} -function tr_Ready() { - if (tr_request.readyState != 4) return; - if (tr_request.status == 200) { - response= tr_request.responseText; - eval('results='+response); - toedit= document.getElementById('routeresults'); - toedit.innerHTML= results.show; - } - tr_request= false; - tr_Request(); -} -window.onload= tr_Needed; - +% $startform->($routestring =~ m/\S/); + +<&| qtextstring, qa => $qa, dbh => $dbh, + thingstring => 'routestring', emsgstore => \$emsg, + perresult => sub { + my ($canonname, $island, $arch) = @_; + push @islandids, $island; + push @archipelagoes, defined $island ? undef : $arch; + } + &> + size=80 + + +Advanced options - you may leave these blank: +

+ + +
+ +Vessel capacity: +<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs', + thingstring => 'capacitystring', emsgstore => \$emsg, + perresult => sub { + ($max_volume,$max_mass) = @_; + } + &> + size=30 + -
-
 

+		 +  +  + + +Estimated loss per league: + +<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'll', + thingstring => 'lossperleague', emsgstore => \$emsg, + perresult => sub { ($lossperleaguepct)= @_; } + &> + size=10 + + +
% } else { #---------- dropdowns, user selects from menus ---------- +% $startform->(grep { +% defined $ARGS{"archipelago$_"} || +% defined $ARGS{"islandid$_"} +% } (0..$qa->{Dropdowns}-1)); + <%perl> -my ($sth,$row);; +my ($sth,$row); my @archlistdata; my %islandlistdata; $islandlistdata{'none'}= [ [ "none", "Select island..." ] ]; @@ -90,8 +146,6 @@ my $optionlistmap= sub { return $out; }; -my $dbh= dbw_connect($a->{Ocean}); - $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands ORDER BY archipelago;"); $sth->execute(); @@ -122,8 +176,6 @@ foreach my $arch (keys %islandlistdata) { - - <&| script &> ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>; function ms_Setarch(dd) { @@ -141,7 +193,7 @@ function ms_Setarch(dd) { -% for my $dd (0..$a->{Dropdowns}-1) { +% for my $dd (0..$qa->{Dropdowns}-1) { -% for my $dd (0..$a->{Dropdowns}-1) { +% for my $dd (0..$qa->{Dropdowns}-1) { % my $arch= $ARGS{"archipelago$dd"}; % $arch= 'none' if !defined $arch;
@@ -164,39 +216,16 @@ function ms_Setarch(dd) { % } #---------- end of dropdowns, now common middle of page code ---------- - - + +% my $ours= sub { $_[0] =~ +% m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^[RT]/; +% }; +<& "lookup:formhidden", ours => $ours &> <%perl> -#========== result computations ========== +#========== results ========== -my $results_head; -$results_head= sub { - print "

Results

\n"; - $results_head= sub { }; -}; - -#---------- result computation - textstring ---------- -if (!$a->{Dropdowns}) { - if (length $routestring) { - $results_head->(); - my $rsr= $m->comp('routetextstring', - ocean => $a->{Ocean}, - string => $routestring, - format => 'return' - ); - if (length $rsr->{Error}) { - print encode_entities($rsr->{Error}); - } else { - foreach my $entry (@{ $rsr->{Results} }) { - push @archipelagoes, - defined $entry->[1] ? undef : $entry->[0]; - push @islandids, $entry->[1]; - } - } - } - -} else { #---------- results - dropdowns ---------- +$emsgokorprint->($emsg) or @islandids=(); my $argorundef= sub { my ($dd,$base) = @_; @@ -205,7 +234,7 @@ my $argorundef= sub { return $thing; }; -for my $dd (0..$a->{Dropdowns}-1) { +for my $dd (0..$qa->{Dropdowns}-1) { my $arch= $argorundef->($dd,'archipelago'); my $island= $argorundef->($dd,'islandid'); next unless defined $arch or defined $island; @@ -213,7 +242,7 @@ for my $dd (0..$a->{Dropdowns}-1) { my $ii= $islandid2{$island}; my $iarch= $ii->{Arch}; if ($iarch ne $arch) { - $results_head->(); + $someresults->(); Specified archipelago <% $arch %> but island <% $ii->{Name} %> @@ -226,12 +255,18 @@ for my $dd (0..$a->{Dropdowns}-1) { push @islandids, $island; } -}#---------- result processing, common stuff % if (@islandids) { -% $results_head->(); - -<& routetrade, islandids => \@islandids, archipelagoes => \@archipelagoes &> - +% $someresults->('Relevant trades'); +<& routetrade, + dbh => $dbh, + islandids => \@islandids, + archipelagoes => \@archipelagoes, + qa => $qa, + max_mass => $max_mass, + max_volume => $max_volume, + lossperleaguepct => $lossperleaguepct + &> + % }