+++ /dev/null
-#!/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;
-use IO::File;
-
-use Commods;
-
-@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'};
-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 json_convert_shim ($) {
- my ($json) = @_;
- # In JSON.pm 2.x, jsonToObj prints a warning to stderr which
- # our callers don't like at all.
- if ($JSON::VERSION >= 2.0) {
- return from_json($json);
- } else {
- return jsonToObj($json);
- }
-}
-
-sub get_arches_islands_pctb ($) {
- my ($ocean)= @_;
- die unless $pctb;
- my $url= "$pctb/islands.php?oceanName=".uc $ocean;
- my $resp= $ua->get($url);
- die $resp->status_line unless $resp->is_success;
- $jsonresp= $resp->content;
- my $jobj= json_convert_shim($resp->content);
- my $arches= [ jparsetable($jobj, 'arches') ];
- my $islands= [ jparsetable($jobj, 'islands') ];
-
- my $islands_done=0;
- foreach my $arch (@$arches) {
-# print Dumper($arnch);
- my $aname= $arch->{'name'};
- die "$jsonresp ?" unless defined $aname;
-
- foreach my $island (@$islands) {
- my $iname= $island->{'name'};
- die "$jsonresp $aname ?" unless defined $iname;
- next unless $arch->{'id'} == $island->{'arch'};
-
- $oceans{$ocean}{$aname}{$iname} .= 'b';
-
- $islands_done++;
- }
- }
- die "$jsonresp $islands_done ?" unless $islands_done == @$islands;
-}
-
-sub get_ocean () {
- my $ocean= $ENV{'YPPSC_OCEAN'}; die unless $ocean;
- return ucfirst lc $ocean;
-}
-
-sub for_islands ($$$$) {
- my ($ocean,$forarch,$forisle,$endarch) = @_;
-
- my $arches= $oceans{$ocean};
- foreach my $aname (sort keys %$arches) {
- &$forarch($ocean,$aname);
- my $islands= $arches->{$aname};
- foreach my $iname (sort keys %$islands) {
- &$forisle($ocean,$aname,$iname);
- }
- &$endarch();
- }
-}
-
-sub for_commods ($) {
- my ($forcommod) = @_;
- foreach my $commod (sort keys %commods) { &$forcommod($commod); }
-}
-
-sub compare_sources_one ($$) {
- my ($srcs,$what) = @_;
- return if $srcs =~ m,^sl?(?:\%sl?)*b$,;
- print "srcs=$srcs $what\n";
-}
-
-sub main__comparesources () {
- my $ocean= get_ocean();
-
- parse_masters();
- get_arches_islands_pctb($ocean);
- parse_pctb_commodmap() or die;
-
- for_islands($ocean,
- sub { },
- sub {
- my ($ocean,$a,$i)= @_;
- my $srcs= $oceans{$ocean}{$a}{$i};
- compare_sources_one($srcs, "island $ocean / $a / $i");
- },
- sub { });
- for_commods(sub {
- my ($commod)= @_;
- my $srcs= $commods{$commod};
- compare_sources_one($srcs, "commodity $commod");
- });
-}
-
-sub main__island () {
- my $ocean= get_ocean();
-
- parse_masters();
- get_arches_islands_pctb($ocean);
-
- for_islands($ocean,
- sub {
- my ($ocean,$aname)= @_;
- ptcl($aname); p(' '); ptcl($aname); p(" {\n");
- },
- sub {
- my ($ocean,$aname,$iname)= @_;
- p(' '); ptcl($iname); p(' '); ptcl($iname); p("\n");
- },
- sub {
- p("}\n");
- });
-}
-
-sub main__sunshinewidget () {
- print <<END
-Land {On land} {
- Crew Crew
- Shoppe Shoppe
- Ye Ye
- Booty Booty
- Ahoy! Ahoy!
-}
-Vessel {On board a ship} {
- Crew Crew
- Vessel Vessel
- Ye Ye
- Booty Booty
- Ahoy! Ahoy!
-}
-END
- or die $!;
-}
-
-&{"main__$which"}(@ARGV);
~yarrgweb / ypp-sc-tools.db-test.git / blobdiff