--- /dev/null
+<%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>
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}
</table>
<table><tr>
-<td>Available capital:
+<td>Available capital<%
+ $routeparams->{SayOptionalCapital} ? ' (optional)' : '' %>:
<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'ac',
thingstring => 'capitalstring', emsgstore => $routeparams->{EmsgRef},
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 |
$stringval='' if !defined $stringval;
my $p= $prefix.'_';
+my $checker= $m->fetch_comp("check_${thingstring}");
+my $significant_nonempty= $checker->attr_exists('significant_nonempty');
+
</%perl>
<&| script &>
<%$p%>timeout=false;
<%$p%>request=false;
-<%$p%>done='';
+<%$p%>done=<% $significant_nonempty ? "null" : "''" %>;
<%$p%>needed='';
function <%$p%>Later(){
window.clearTimeout(<%$p%>timeout);
<div id="<%$p%>results"> </div><br>
<%perl>
-if (length $thingstring) {
+if ($significant_nonempty || length $thingstring) {
my ($emsg,$canonstring,@results)= $m->comp('qtextstringcheck',
what => $thingstring,
ocean => $qa->{Ocean},
<%args>
$quri
$dbh
+$islandstring => '';
$capacitystring => '';
$lossperleague => '';
$capitalstring => '';
+$distance => '';
+$someresults
$emsgokorprint
</%args>
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>
<&| 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>