chiark / gitweb /
where-vessels shows uncolonised islands differently
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sat, 7 Aug 2010 11:21:37 +0000 (12:21 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sat, 7 Aug 2010 11:21:37 +0000 (12:21 +0100)
yarrg/CommodsScrape.pm
yarrg/where-vessels

index 2b1d4a9add9ed0bf0d1cc49d63e55a6996348e97..d6951cf6b905e99c792a280013cd94395b1ba521 100644 (file)
@@ -46,7 +46,7 @@ sub yppedia_chart_parse ($$ $$$$ $) {
        $conv_nxy, $on_archlabel, $on_island, $on_league,
        $on_incomprehensible) = @_;
 
-    my ($x,$y, $arch,$island,$solid,$dirn);
+    my ($x,$y, $arch,$island,$sizecol,$solid,$dirn);
     my $nn= sub { return $conv_nxy->($x,$y) };
     
     # We don't even bother with tag soup; instead we do line-oriented parsing.
@@ -68,12 +68,12 @@ sub yppedia_chart_parse ($$ $$$$ $) {
            $on_archlabel->($x,$y,$arch);
        } elsif (m/^\{\{ chart\ label \|\d+\|\d+\|
                 \<big\> \'+ \[\[ .* \b ocean \]\]/xi) {
-       } elsif (($x,$y,$island) =
+       } elsif (($x,$y,$island,$sizecol) =
            m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\|
-                   ([^| ][^|]*[^| ]) \| .*\}\}$/xi) {
+                   ([^| ][^|]*[^| ]) \| [^|]* \| (\w+) \| .*\}\}$/xi) {
            my $n= $nn->();
            printf $debugfh "%2d,%-2d island %s\n", $x,$y,$island;
-           $on_island->($n, $island);
+           $on_island->($n, $island, $sizecol);
        } elsif (($solid,$x,$y,$dirn) =
            m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
                    \.?([-\/\\o])\.? \| .*\}\}$/xi) {
index 33df7f83c42aa44731c10a6327ff79a683fbbbd3..7e64cce85e60a5d97401fee79a8fc025c8e54e31 100755 (executable)
@@ -744,7 +744,7 @@ proc load-chart {} {
        yppedia_chart_parse(\*STDIN, (new IO::File ">/dev/null"),
                sub { sprintf "%d %d", @_; },
                sub { printf "archlabel %d %d %s\n", @_; },
-               sub { printf "island %s %s\n", @_; },
+               sub { printf "island %s {%s} %s\n", @_; },
                sub { printf "league %s %s %s.\n", @_; },
                sub { printf STDERR "warning: %s: incomprehensible: %s", @_; }
                        );
@@ -761,17 +761,19 @@ proc coord {c} {
 }
 
 proc chart-got/archlabel {args} { }
-proc chart-got/island {x y args} {
-#      debug "ISLE $x $y $args"
+proc chart-got/island {x y isle sizecol} {
+       debug "ISLE $x $y $isle $sizecol"
        global canvas isleloc
-       set isleloc($args) [list $x $y]
+       set isleloc($isle) [list $x $y]
        set sz 5
 #      $canvas create oval \
 #              [expr {[coord $x] - $sz}] [expr {[coord $y] - $sz}] \
 #              [expr {[coord $x] + $sz}] [expr {[coord $y] + $sz}] \
 #              -fill blue
+       set colour "#888"
+       if {[string match *_col $sizecol]} { set colour black }
        $canvas create text [coord $x] [coord $y] \
-               -text $args -anchor s
+               -text $isle -anchor s -fill $colour
 }
 proc chart-got/league {x1 y1 x2 y2 kind} {
 #      debug "LEAGUE $x1 $y1 $x2 $y2 $kind"