use invented icons for unknown ship classes

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

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index c5ec9b03ffec39e97ebf2d30a9421912e1145cb9..092e8dad663e8c642edffc1cc92f8b59c2a16bd2 100755 (executable)
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -103,6 +103,8 @@ proc nextarg {} {
 
 set notes_loc vessel-notes
 set scraper {./yppedia-ocean-scraper --chart}
+set info_cache _vessel-info-cache
+set info_source rsync.yarrg.chiark.net::yarrg/vessel-info
 
 proc parseargs {} {
     global ai argv
@@ -118,6 +120,7 @@ proc parseargs {} {
            --clipboard-file { load-clipboard-file [nextarg] }
            --local-html-dir { lappend scraper --local-html-dir=[nextarg] }
            --notes { glset notes_loc [nextarg] }
+           --vessel-info-source { glset info_source [nextarg] }
            --debug { incr debug }
            default { badusage "unknown option $arg" }
        }
@@ -246,34 +249,33 @@ proc display-note-infos {} {
 
 #---------- vessel properties ----------
 
-set vessel_class_info {
-       smsloop         am      sl      Sloop
-       lgsloop         bm      ct      Cutter
-       dhow            cm      dh      Dhow
-       longship        dm      ls      Longship
-       baghlah         em      bg      Baghlah
-       junk            eo      jk      Junk
-       merchbrig       fm      mb      {Merchant Brig}
-       warbrig         gm      wb      {War Brig}
-       xebec           hm      xe      Xebec
-       merchgal        jm      mg      {Merchant Galleon}
-       warfrig         im      wf      {War Frigate}
-       grandfrig       km      gf      {Grand Frigate}
-}
-
-set vessel_subclass_info {
-       celtic   E      {Emerald class}
-       icy      F      {Frost class}
-       rogue    R      {Rogue class}
-       verdant  V      {Verdant class}
-       inferno  I      {Inferno class}
+proc info-cache-update {} {
+    global info_source info_cache
+    file mkdir $info_cache
+    exec sh -c "cp -u icons/* $info_cache/."
+
+    if {[string length $info_source]} {
+       set cmdl [list \
+                 rsync -udLKtOzm \
+                 --exclude=*~ --exclude=*.bak --exclude=.* --exclude=*.tmp \
+                 $info_source/ $info_cache 2>@ stderr]
+       debug "INFO-CACHE $cmdl"
+       eval exec $cmdl
+    }
+
+    set f [open $info_cache/vessel-info]
+    glset vessel_class_data [read $f]
+    close $f
 }
 
 proc vesselclasses-init {} {
     global vc_game2code vc_code2abbrev vc_code2full vc_codes
-    global vessel_class_info vessel_subclass_info
+
+    global vessel_class_data
+    manyset $vessel_class_data classinfos subclassinfos
+
     set vc_codes {}
-    foreach {game code abbrev full} $vessel_class_info {
+    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" }
        lappend vc_codes $code
@@ -287,7 +289,7 @@ proc vesselclasses-init {} {
     global vsc_game2code
     set vsc_game2code(null) {}
     set vsc_code2report() Ordinary
-    foreach {game code full} $vessel_subclass_info {
+    foreach {game code full} $subclassinfos {
        if {![regexp {^[A-Z]$} $code code]} { error "bad code" }
        set vsc_game2code($game) $code
        set vsc_code2report($code) $full
@@ -359,8 +361,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 \
@@ -600,7 +608,18 @@ proc vessel {vin} {
 
     set gameclass [errexpect-arrayget vi vesselClass]
     upvar #0 vc_game2code($gameclass) class
-    if {![info exists class]} { errexpect-error "unexpected vesselClass"}
+    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]
@@ -1179,9 +1198,10 @@ proc invoke_notes {} {
 #---------- main program ----------
 
 parseargs
-vesselclasses-init
 argdefaults
 httpclientsetup where-vessels
+info-cache-update
+vesselclasses-init
 load-chart
 widgets-setup
 make-filters