X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=7e64cce85e60a5d97401fee79a8fc025c8e54e31;hp=272a11432b37f6c6d7169f773b89a621790e7326;hb=84e330af6dabd818db6e87e0ff57db45fdf176ca;hpb=faba831bf482467efd38e779aada81746a90996f diff --git a/yarrg/where-vessels b/yarrg/where-vessels index 272a114..7e64cce 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" } } @@ -246,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 @@ -270,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} { @@ -279,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" @@ -336,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 \ @@ -377,10 +410,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 { @@ -576,14 +610,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]/[ \ @@ -698,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", @_; } ); @@ -715,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" @@ -1154,9 +1202,10 @@ proc invoke_notes {} { #---------- main program ---------- parseargs -vesselclasses-init argdefaults httpclientsetup where-vessels +info-cache-update +vesselclasses-init load-chart widgets-setup make-filters