chiark / gitweb /
Rename yppsc-* helpers
[ypp-sc-tools.db-live.git] / pctb / dictionary-pixmap-options
1 #!/usr/bin/perl -w
2
3 # helper program for determining pixmap resolution options
4
5 # This is part of ypp-sc-tools, a set of third-party tools for assisting
6 # players of Yohoho Puzzle Pirates.
7 #
8 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
9 #
10 # This program is free software: you can redistribute it and/or modify
11 # it under the terms of the GNU General Public License as published by
12 # the Free Software Foundation, either version 3 of the License, or
13 # (at your option) any later version.
14 #
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 # GNU General Public License for more details.
19 #
20 # You should have received a copy of the GNU General Public License
21 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
22 #
23 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
24 # are used without permission.  This program is not endorsed or
25 # sponsored by Three Rings.
26
27 use strict (qw(vars));
28 use LWP::UserAgent;
29 use JSON;
30 #use Data::Dumper;
31
32 @ARGV==1 or die "You probably don't want to run this program directly.\n";
33 our ($which) = shift @ARGV;
34
35 $which =~ s/\W//g;
36
37 our ($pctb) = $ENV{'YPPSC_PCTB_PCTB'};  die unless $pctb;
38 our ($ua)= LWP::UserAgent->new;
39 our $jsonresp;
40
41 sub jparsetable ($$) {
42     my ($jobj,$wh) = @_;
43     my $jtab= $jobj->{$wh};
44     die "$jsonresp $wh ?" unless defined $jtab;
45     my $cns= $jtab->{'colNames'};  die "$jsonresp $wh ?" unless defined $cns;
46     my $ad= $jtab->{'arrayData'};  die "$jsonresp $wh ?" unless defined $ad;
47     my @o=();
48     foreach my $ai (@$ad) {
49         @$ai == @$cns or die "$jsonresp $wh ".scalar(@o)."?";
50         my $v= { };
51         for (my $i=0; $i<@$cns; $i++) {
52             $v->{$cns->[$i]} = $ai->[$i];
53         }
54         push @o, $v;
55     }
56     return @o;
57 }
58 sub sort_by_name {
59     sort {
60         $a->{'name'} cmp $b->{'name'};
61     } @_;
62 }
63
64 sub p ($) { print $_[0] or die $!; }
65 sub ptcl ($) {
66     local ($_) = @_;
67     die "$_ $& ?" if m/[^-+'"# 0-9a-z]/i;
68     p("{$_[0]}");
69 }
70     
71 sub main__island () {
72     my $url= "$pctb/islands.php?oceanName=SAGE";
73     my $resp= $ua->get($url);
74     die $resp->status_line unless $resp->is_success;
75     $jsonresp= $resp->content;
76     my $jobj= jsonToObj($resp->content);
77     my @arches= jparsetable($jobj, 'arches');
78     my @islands= jparsetable($jobj, 'islands');
79 #    print Dumper(\@arches, \@islands);
80     my $islands_done=0;
81     foreach my $arch (sort_by_name(@arches)) {
82 #       print Dumper($arch);
83         my $aname= $arch->{'name'};
84         die "$jsonresp ?" unless defined $aname;
85         ptcl($aname); p(' '); ptcl($aname); p(" {\n");
86         foreach my $island (sort_by_name(@islands)) {
87             my $iname= $island->{'name'};
88             die "$jsonresp $aname ?" unless defined $iname;
89             next unless $arch->{'id'} == $island->{'arch'};
90             p('    '); ptcl($iname); p(' '); ptcl($iname); p("\n");
91             $islands_done++;
92         }
93         p("}\n");
94     }
95     die "$jsonresp $islands_done ?" unless $islands_done == @islands;
96 }
97
98 sub main__sunshinewidget () {
99     print <<END
100 Land {On land} {
101     Crew   Crew
102     Shoppe Shoppe
103     Ye     Ye
104     Booty  Booty
105     Ahoy!  Ahoy!
106 }
107 Ship {On board a ship} {
108     Crew   Crew
109     Vessel Vessel
110     Ye     Ye
111     Booty  Booty
112     Ahoy!  Ahoy!
113 }
114 END
115     or die $!;
116 }
117
118 &{"main__$which"}();