X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=092e8dad663e8c642edffc1cc92f8b59c2a16bd2;hp=9b8c7728a41ade97694f961749ba0d4b20ff3f64;hb=a3b33e44585826206ea6ccd78cac39f452bf0daf;hpb=d08aa8fd6412ed025a8d2afcbdc36c098b019da4

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 9b8c772..092e8da 100755
--- 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" }
 	}
@@ -133,6 +136,9 @@ proc argdefaults {} {
 	if {[info exists ocean]} { lappend cmd --ocean $ocean }
 	if {[info exists pirate]} { lappend cmd --pirate $pirate }
 	manyset [split [eval exec $cmd] " "] ocean pirate
+	if {![llength $ocean] || ![llength $pirate]} {
+	    error "$ocean $pirate ?"
+	}
     }
     lappend scraper $ocean
 }
@@ -243,23 +249,35 @@ proc display-note-infos {} {
 
 #---------- vessel properties ----------
 
+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
-    set vcl {
-	smsloop		am	sl	Sloop
-	lgsloop		bm	ct	Cutter
-	dhow		cm	dh	Dhow
-	longship	dm	ls	Longship
-	baghlah		em	bg	Baghlah
-	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}
-    }
+
+    global vessel_class_data
+    manyset $vessel_class_data classinfos subclassinfos
+
     set vc_codes {}
-    foreach {game code abbrev full} $vcl {
+    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
 	set vc_game2code($game) $code
 	set vc_code2abbrev($code) $abbrev
@@ -267,6 +285,16 @@ proc vesselclasses-init {} {
 	load-icon $abbrev
     }
 
+    global vsc_code2report
+    global vsc_game2code
+    set vsc_game2code(null) {}
+    set vsc_code2report() Ordinary
+    foreach {game code full} $subclassinfos {
+	if {![regexp {^[A-Z]$} $code code]} { error "bad code" }
+	set vsc_game2code($game) $code
+	set vsc_code2report($code) $full
+    }
+
     load-icon atsea
     foreach a {battle borrow dot} {
 	foreach b {ours dot query} {
@@ -333,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 \
@@ -374,10 +408,11 @@ proc show-report-decode {code} {
     report-set inport [lindex {{At Sea} {In port}} $inport]
     report-set class $vc_code2full($classcode)
 
-    switch -exact $subclass {
-	{} { report-set subclass {Ordinary} }
-	F { report-set subclass {"Frost class"} }
-	default { report-set subclass "Subclass \"$subclass\"" }
+    upvar #0 vsc_code2report($subclass) subclass_report
+    if {[info exists subclass_report]} {
+	report-set subclass $subclass_report
+    } else {
+	report-set subclass "Subclass \"$subclass\""
     }
 
     report-set lock [lindex {
@@ -573,14 +608,26 @@ 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 subclass [errexpect-arrayget vi vesselSubclass]
-    switch -exact $subclass {
-	null		{ lappend codel {} }
-	icy		{ lappend codel F }
-	default		{ lappend codel ($subclass) }
+    set gamesubclass [errexpect-arrayget vi vesselSubclass]
+    upvar #0 vsc_game2code($gamesubclass) subclass
+    if {[info exists subclass]} {
+	lappend codel $subclass
+    } else {
+	lappend codel ($gamesubclass)
     }
 
     switch -exact [errexpect-arrayget vi isLocked]/[ \
@@ -1151,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