where-vessels shows uncolonised islands differently

[ypp-sc-tools.db-test.git] / yarrg / where-vessels

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 5af2dfaf41129847defe886d547725d1b6677726..7e64cce85e60a5d97401fee79a8fc025c8e54e31 100755 (executable)
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -275,8 +275,6 @@ proc vesselclasses-init {} {
     manyset $vessel_class_data classinfos subclassinfos
 
     set vc_codes {}
-    set vc_code2abbrev(zz) vcunk
-    load-icon vcunk
     foreach {game code abbrev full} $classinfos {
        if {![regexp {^[a-z][a-z]$} $code code]} { error "bad code" }
        if {![regexp {^[a-z][a-z]$} $abbrev abbrev]} { error "bad abbrev" }
@@ -306,14 +304,16 @@ proc vesselclasses-init {} {
 }
 
 proc load-icon {icon} {
-    image create bitmap icon/$icon -file icons/$icon.xbm
+    global info_cache
+    image create bitmap icon/$icon -file $info_cache/$icon.xbm
 }
 
 proc load-icon-combine {args} {
+    global info_cache
     set cmd {}
     set delim "pnmcat -lr "
     foreach icon $args {
-       append cmd $delim " <(xbmtopbm icons/$icon.xbm)"
+       append cmd $delim " <(xbmtopbm $info_cache/$icon.xbm)"
        set delim " <(pbmmake -white 1 1)"
     }
     append cmd " | pbmtoxbm"
@@ -363,8 +363,14 @@ proc code2canvas {code canvas x yvar qty qtylen bind} {
        incr stackx
     }
     
+    upvar #0 vc_code2abbrev($class) vcabb
+    if {![info exists vcabb]} {
+       set vcabb vc-$class
+       image create bitmap icon/$vcabb -data \
+           [exec pbmtext -builtin fixed $class | pnminvert | pnmcrop >t.pnm]
+    }
     canvas-horiz-stack stackx -1 $imy $bind \
-           image -anchor nw -image icon/$vc_code2abbrev($class)
+           image -anchor nw -image icon/$vcabb
 
     if {[string length $subclass]} {
        canvas-horiz-stack stackx 0 $y $bind \
@@ -604,11 +610,19 @@ proc vessel {vin} {
 
     set gameclass [errexpect-arrayget vi vesselClass]
     upvar #0 vc_game2code($gameclass) class
-    if {[info exists class]} {
-       lappend codel $class
-    } else {
-       lappend codel zz
+    if {![info exists class]} {
+       set class "($gameclass)"
+       upvar #0 vc_code2abbrev($class) vcabb
+       set vcabb vc-$class
+       set data [exec pbmtext -builtin fixed " $gameclass " \
+                | pnminvert | pnmcrop | pbmtoxbm]
+       debug "INVENTED ICON $vcabb $data"
+       image create bitmap icon/$vcabb -data $data
+           
+       global vc_code2full
+       set vc_code2full($class) "Type \"$gameclass\""
     }
+    lappend codel $class
 
     set gamesubclass [errexpect-arrayget vi vesselSubclass]
     upvar #0 vsc_game2code($gamesubclass) subclass
@@ -730,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", @_; }
                        );
@@ -747,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"