yarrg/ocean-topology-graph

   1 #!/usr/bin/perl -w
   2
   3 # This is part of the YARRG website.  YARRG is a tool and website
   4 # for assisting players of Yohoho Puzzle Pirates.
   5 #
   6 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
   7 #
   8 # This program is free software: you can redistribute it and/or modify
   9 # it under the terms of the GNU Affero General Public License as
  10 # published by the Free Software Foundation, either version 3 of the
  11 # License, or (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU Affero General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU Affero General Public License
  19 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20 #
  21 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  22 # are used without permission.  This program is not endorsed or
  23 # sponsored by Three Rings.
  24
  25 use strict (qw(vars));
  26
  27 use CommodsDatabase;
  28
  29 my $ocean= shift @ARGV;
  30
  31 db_setocean($ocean);
  32 db_connect();
  33 my $islands= $dbh->selectall_arrayref('
  34         SELECT islandid,islandname FROM islands;
  35 ');
  36 my $routes= $dbh->selectall_arrayref('
  37         SELECT aiid, biid, dist FROM routes;
  38 ');
  39 $dbh->disconnect();
  40
  41 #use Data::Dumper;
  42 #print Dumper($results);
  43
  44 print "strict graph $ocean {\n";
  45 print "    splines=true;\n";
  46 print "    nslimit=10;\n";
  47 print "    mclimit=10;\n";
  48
  49 foreach my $row (@$islands) {
  50     my ($id,$str) = @$row;
  51     $str =~ s/[\"\\]/\\$&/g;
  52     print "    n$id [ label=\"$str\" ];\n";
  53 }
  54 foreach my $row (@$routes) {
  55     my ($ia,$ib,$dist) = @$row;
  56     print "    n$ia -- n$ib [ w=".(1.0/($dist*$dist)).", len=".(0.5*$dist+1).", label=$dist ];\n";
  57     #len=$dist, minlen=$dist, , ,
  58     #w=".(1.0/$dist).",
  59 }
  60
  61 print "}\n";