WIP routesearch UI: entry done, now must compute results

diff --git a/yarrg/web/check_distance b/yarrg/web/check_distance
new file mode 100644 (file)
index 0000000..223cc5a
--- /dev/null
+++ b/yarrg/web/check_distance
@@ -0,0 +1,68 @@
+<%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 <ijackson@chiark.greenend.org.uk>
+ 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 <http://www.gnu.org/licenses/>.
+
+ 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 simply defines how to interpret distances.
+
+</%doc>
+
+<%attr>
+significant_nonempty => 1
+</%attr>
+
+<%method execute>
+<%args>
+$string
+$dbh
+$debugf
+</%args>
+
+<%perl>
+
+$_= $string;
+s/^\s+//; s/\s+$//;
+
+my $leagues;
+my $canon;
+
+if (!m/\S/) {
+       $leagues= 20;
+       $canon= '(default: 20 leagues)';
+} elsif (m/^([1-9]\d*)( leagues)?$/i) {
+       $leagues= $1;
+       $canon= "$leagues leagues";
+} else {
+       expected_error("Cannot understand distance \`$_'.");
+}
+
+return ($canon,$leagues);
+
+</%perl>
+</%method>

diff --git a/yarrg/web/enter_advrouteopts b/yarrg/web/enter_advrouteopts
index 2a5eff0e5c5c677334ec055b709d1c566cfdb4f6..c8a6ddbb2429a983e40fad372fb97821564b9f03 100644 (file)
--- a/yarrg/web/enter_advrouteopts
+++ b/yarrg/web/enter_advrouteopts
@@ -32,8 +32,10 @@
  This Mason component generates entry fields for route planning
  advanced parameters (capacity limits, etc).
 
- The results are returned in $routeparams:
+ Some useful parameters are in %$routeparams:
        ${ $routeparams->{EmsgRef} }
+       $routeparams->{SayOptionalCapital}
+ The results are returned there:
        $routeparams->{LossPerLeaguePct}
        $routeparams->{MaxMass}
        $routeparams->{MaxVolume}
@@ -78,7 +80,8 @@ Expected losses:
 </table>
 <table><tr>
 
-<td>Available capital:
+<td>Available capital<%
+ $routeparams->{SayOptionalCapital} ? ' (optional)' : '' %>:
 
 <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'ac',
     thingstring => 'capitalstring', emsgstore => $routeparams->{EmsgRef},

diff --git a/yarrg/web/lookup b/yarrg/web/lookup
index 93e44d4455df1cb89043dca178c22525c4239095..9f74f3369bb8e7bcf33601c73c8eca3831997114 100755 (executable)
--- a/yarrg/web/lookup
+++ b/yarrg/web/lookup
@@ -159,8 +159,8 @@ foreach my $var (@vars) {
 
 foreach my $var (keys %ARGS) {
        next unless $var =~
-               m/^(?: (?:route|commod|capacity|capital)string |
-                       lossperleague |
+               m/^(?: (?:route|commod|capacity|capital|island)string |
+                       lossperleague | distance |
                        commodid |
                        islandid \d |
                        archipelago \d |

diff --git a/yarrg/web/qtextstring b/yarrg/web/qtextstring
index c958915ae33fdfa012c0e9ab639db0636d84b95e..93eb1249633499550bf763cb7c33ccd1c735115b 100644 (file)
--- a/yarrg/web/qtextstring
+++ b/yarrg/web/qtextstring
@@ -49,6 +49,9 @@ my $stringval= $qa->{$thingstring};
 $stringval='' if !defined $stringval;
 
 my $p= $prefix.'_';
+my $checker= $m->fetch_comp("check_${thingstring}");
+my $significant_nonempty= $checker->attr_exists('significant_nonempty');
+
 </%perl>
 
 <&| script &>
@@ -58,7 +61,7 @@ my $p= $prefix.'_';
 
 <%$p%>timeout=false;
 <%$p%>request=false;
-<%$p%>done='';
+<%$p%>done=<% $significant_nonempty ? "null" : "''" %>;
 <%$p%>needed='';
 function <%$p%>Later(){
   window.clearTimeout(<%$p%>timeout);
@@ -103,7 +106,7 @@ register_onload(<%$p%>Needed);
 <div id="<%$p%>results">&nbsp;</div><br>
 
 <%perl>
-if (length $thingstring) {
+if ($significant_nonempty || length $thingstring) {
        my ($emsg,$canonstring,@results)= $m->comp('qtextstringcheck',
                what => $thingstring,
                ocean => $qa->{Ocean},

diff --git a/yarrg/web/query_routesearch b/yarrg/web/query_routesearch
index 53128f6483d255723b1ec4df69b2617dbde54387..bbeba5b522e59ce506ec29d9fb334fa01ae93334 100644 (file)
--- a/yarrg/web/query_routesearch
+++ b/yarrg/web/query_routesearch
@@ -36,9 +36,12 @@
 <%args>
 $quri
 $dbh
+$islandstring => '';
 $capacitystring => '';
 $lossperleague => '';
 $capitalstring => '';
+$distance => '';
+$someresults
 $emsgokorprint
 </%args>
 
@@ -48,8 +51,9 @@ my @warningfs;
 my @islandids;
 
 my $qa= \%ARGS;
-my $routeparams= { EmsgRef => \$emsg };
+my $routeparams= { EmsgRef => \$emsg, SayOptionalCapital => 1 };
 my $maxdist;
+
 </%perl>
 
 <h1>Find most profitable routes and trades</h1>
@@ -67,12 +71,23 @@ This feature is not available from the "drop down menus" interface.
 
 <&| enter_advrouteopts, qa=>$qa, dbh=>$dbh, routeparams=>$routeparams &>
 <td>
- Something:
+ Maximum distance:
  <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'ml',
-    thingstring => 'capitalstring', emsgstore => \$emsg,
+    thingstring => 'distance', emsgstore => \$emsg,
     onresults => sub { ($maxdist)= @_; } &>
  </&>
 </&>
 
+<input type=submit name=submit value="Go">
+% my $ours= sub { $_[0] =~ m/^lossperleague|^islandstring|^capitalstring|^capacitystring|^distance/; };
+<& "lookup:formhidden", ours => $ours &>
 
 % }
+
+</form>
+<%perl>
+
+$emsgokorprint->($emsg) or return;
+@islandids or return;
+
+</%perl>