Rename yppsc-* helpers

[ypp-sc-tools.db-test.git] / pctb / dictionary-pixmap-options

diff --git a/pctb/dictionary-pixmap-options b/pctb/dictionary-pixmap-options
new file mode 100755 (executable)
index 0000000..5b7a825
--- /dev/null
+++ b/pctb/dictionary-pixmap-options
@@ -0,0 +1,118 @@
+#!/usr/bin/perl -w
+
+# helper program for determining pixmap resolution options
+
+# This is part of ypp-sc-tools, a set of third-party tools for assisting
+# players of Yohoho Puzzle Pirates.
+#
+# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU 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 General Public License for more details.
+#
+# You should have received a copy of the GNU 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.
+
+use strict (qw(vars));
+use LWP::UserAgent;
+use JSON;
+#use Data::Dumper;
+
+@ARGV==1 or die "You probably don't want to run this program directly.\n";
+our ($which) = shift @ARGV;
+
+$which =~ s/\W//g;
+
+our ($pctb) = $ENV{'YPPSC_PCTB_PCTB'};  die unless $pctb;
+our ($ua)= LWP::UserAgent->new;
+our $jsonresp;
+
+sub jparsetable ($$) {
+    my ($jobj,$wh) = @_;
+    my $jtab= $jobj->{$wh};
+    die "$jsonresp $wh ?" unless defined $jtab;
+    my $cns= $jtab->{'colNames'};  die "$jsonresp $wh ?" unless defined $cns;
+    my $ad= $jtab->{'arrayData'};  die "$jsonresp $wh ?" unless defined $ad;
+    my @o=();
+    foreach my $ai (@$ad) {
+       @$ai == @$cns or die "$jsonresp $wh ".scalar(@o)."?";
+       my $v= { };
+       for (my $i=0; $i<@$cns; $i++) {
+           $v->{$cns->[$i]} = $ai->[$i];
+       }
+       push @o, $v;
+    }
+    return @o;
+}
+sub sort_by_name {
+    sort {
+       $a->{'name'} cmp $b->{'name'};
+    } @_;
+}
+
+sub p ($) { print $_[0] or die $!; }
+sub ptcl ($) {
+    local ($_) = @_;
+    die "$_ $& ?" if m/[^-+'"# 0-9a-z]/i;
+    p("{$_[0]}");
+}
+    
+sub main__island () {
+    my $url= "$pctb/islands.php?oceanName=SAGE";
+    my $resp= $ua->get($url);
+    die $resp->status_line unless $resp->is_success;
+    $jsonresp= $resp->content;
+    my $jobj= jsonToObj($resp->content);
+    my @arches= jparsetable($jobj, 'arches');
+    my @islands= jparsetable($jobj, 'islands');
+#    print Dumper(\@arches, \@islands);
+    my $islands_done=0;
+    foreach my $arch (sort_by_name(@arches)) {
+#      print Dumper($arch);
+       my $aname= $arch->{'name'};
+       die "$jsonresp ?" unless defined $aname;
+       ptcl($aname); p(' '); ptcl($aname); p(" {\n");
+       foreach my $island (sort_by_name(@islands)) {
+           my $iname= $island->{'name'};
+           die "$jsonresp $aname ?" unless defined $iname;
+           next unless $arch->{'id'} == $island->{'arch'};
+           p('    '); ptcl($iname); p(' '); ptcl($iname); p("\n");
+           $islands_done++;
+       }
+       p("}\n");
+    }
+    die "$jsonresp $islands_done ?" unless $islands_done == @islands;
+}
+
+sub main__sunshinewidget () {
+    print <<END
+Land {On land} {
+    Crew   Crew
+    Shoppe Shoppe
+    Ye     Ye
+    Booty  Booty
+    Ahoy!  Ahoy!
+}
+Ship {On board a ship} {
+    Crew   Crew
+    Vessel Vessel
+    Ye     Ye
+    Booty  Booty
+    Ahoy!  Ahoy!
+}
+END
+    or die $!;
+}
+
+&{"main__$which"}();