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 BEGIN { unshift @INC, qw(.) }
  26
  27 use strict (qw(vars));
  28
  29 use CommodsDatabase;
  30
  31 my $ocean= shift @ARGV;
  32
  33 db_setocean($ocean);
  34 db_connect();
  35 my $islands= $dbh->selectall_arrayref('
  36         SELECT islandid,islandname FROM islands;
  37 ');
  38 my $routes= $dbh->selectall_arrayref('
  39         SELECT aiid, biid, dist FROM routes;
  40 ');
  41 $dbh->disconnect();
  42
  43 #use Data::Dumper;
  44 #print Dumper($results);
  45
  46 print "strict graph $ocean {\n";
  47 print "    splines=true;\n";
  48 print "    nslimit=10;\n";
  49 print "    mclimit=10;\n";
  50
  51 foreach my $row (@$islands) {
  52     my ($id,$str) = @$row;
  53     $str =~ s/[\"\\]/\\$&/g;
  54     print "    n$id [ label=\"$str\" ];\n";
  55 }
  56 foreach my $row (@$routes) {
  57     my ($ia,$ib,$dist) = @$row;
  58     print "    n$ia -- n$ib [ w=".(1.0/($dist*$dist)).", len=".(0.5*$dist+1).", label=$dist ];\n";
  59     #len=$dist, minlen=$dist, , ,
  60     #w=".(1.0/$dist).",
  61 }
  62
  63 print "}\n";