X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=9ec3b35fc8ee8b139abcd94286672cce43df76af;hb=de02daca3d377ebdd1e53689e5c3470f7284b726;hp=66d8527a6a6d88784491efcb9d41487b599676c9;hpb=c221fee571a483c7ff5a51703a228c254cb050f3;p=ypp-sc-tools.db-test.git diff --git a/yarrg/where-vessels b/yarrg/where-vessels index 66d8527..9ec3b35 100755 --- a/yarrg/where-vessels +++ b/yarrg/where-vessels @@ -66,6 +66,14 @@ proc errexpect-arrayget {arrayvar key} { errexpect-error "undefined $key" } +proc errexpect-arrayget-boolean {arrayvar key} { + switch -exact [uplevel 1 [list errexpect-arrayget $arrayvar $key]] { + true { return 1 } + false { return 0 } + default { errexpect-error "unexpected $key" } + } +} + proc errexpect-catch {code} { global errorInfo errorCode set rc [catch { @@ -180,9 +188,9 @@ proc parse-notes {} { } } -proc note-info {lno vid name description} { +proc note-info {lno vid name island description} { global note_infos - lappend note_infos [list $lno $vid $name $description] + lappend note_infos [list $lno $vid $name $island $description] } proc display-note-infos {} { @@ -202,15 +210,17 @@ proc display-note-infos {} { set infodata {} foreach info $note_infos { - manyset $info lno vid name description + manyset $info lno vid name island description append infodata "vessel" append infodata " $vid" if {[string length $name]} { append infodata " $name" } + if {[string length $island]} { append infodata " ($island)" } append infodata ": " $description "\n" } if {$nmissing} { - append infodata "$nmissing vessels not mentioned in notes:\n" + if {[string length $infodata]} { append infodata "\n" } + append infodata "$nmissing vessel(s) not mentioned in notes:\n" set last_island {} foreach info [lsort $note_missings] { manyset $info island name vid @@ -225,50 +235,82 @@ proc display-note-infos {} { parser-control-failed-core .ctrl.notes notes \ white blue 0 \ $tiny \ - "[llength $note_infos] warnings;\ - $nmissing vessels missing" \ + "[llength $note_infos] warning(s);\ + $nmissing vessel(s) missing" \ "Full description of warnings and missing vessels:" \ $infodata } +#---------- vessel properties ---------- + +proc vesselclasses-init {} { + global vc_game2code vc_code2abbrev vc_abbrev2full + foreach {game code abbrev full} { + 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 + warfrig im wf {War Frigate} + merchgal jm mg {Merchant Galleon} + grandfrig km gf {Grand Frigate} + } { + set vc_game2code($game) $code + set vc_code2abbrev($code) $abbrev + set vc_abbrev2full($abbrev) $full + } +} + +proc code2abbrev {code} { + global vc_code2abbrev + + manyset [split $code _] inport class subclass lockown xabbrev + manyset [split $lockown ""] lock own + + set abbrev {} + append abbrev [lindex {? {}} $inport] + append abbrev $vc_code2abbrev($class) + append abbrev $subclass + append abbrev [lindex {* + -} $lock] + append abbrev [lindex {- = ?} [regsub {\D} $own 2]] + append abbrev $xabbrev + + debug "CODE2ABBREV $code $abbrev" + return $abbrev +} + #---------- loading and parsing the clipboard (vessel locations) ---------- proc vessel {vin} { global pirate notes_used note_missings newnotes upvar 1 $vin vi - set abbrev {} - switch -exact [errexpect-arrayget vi inPort] { - true { } - false { append abbrev ? } - default { errexpect-error "unexpected inPort" } - } - switch -exact [errexpect-arrayget vi vesselClass] { - smsloop { set sz 00sl } - lgsloop { set sz 01ct } - dhow { set sz 02dh } - longship { set sz 03ls } - baghlah { set sz 04bg } - merchbrig { set sz 05mb } - warbrig { set sz 06wb } - xebec { set sz 07xe } - warfrig { set sz 08wf } - merchgal { set sz 09mg } - grandfrig { set sz 10gf } - default { errexpect-error "unknown class" } - } - append abbrev $sz - switch -exact [errexpect-arrayget vi vesselSubclass] { - null { } - icy { append abbrev F } - default { errexpect-error "unknown subclass ?" } + + set codel {} + lappend codel [errexpect-arrayget-boolean vi inPort] + + set gameclass [errexpect-arrayget vi vesselClass] + upvar #0 vc_game2code($gameclass) class + if {![info exists class]} { errexpect-error "unexpected vesselClass"} + lappend codel $class + + set subclass [errexpect-arrayget vi vesselSubclass] + switch -exact $subclass { + null { lappend codel {} } + icy { lappend codel F } + default { lappend codel ($subclass) } } + switch -exact [errexpect-arrayget vi isLocked]/[ \ errexpect-arrayget vi isBattleReady] { - true/false { append abbrev 2- } - false/false { append abbrev 1+ } - false/true { append abbrev 0* } + true/false { set lock 2 } + false/false { set lock 1 } + false/true { set lock 0 } default { errexpect-error "unexpected isLocked/isBattleReady" } } + set vid [errexpect-arrayget vi vesselId] upvar #0 notes($vid) note set realname [errexpect-arrayget vi vesselName] @@ -279,28 +321,34 @@ proc vessel {vin} { if {[info exists note]} { manyset $note lno notename owner xabbrev if {[string compare -nocase $realname $notename]} { - note-info $lno $vid $realname \ - "notes say name is $notename - perhaps renamed" + note-info $lno $vid $realname $island \ + "notes say name is $notename" } if {[string length $owner]} { if {![string compare $owner $pirate]} { - append abbrev = + set own 1 } else { - append abbrev - + set own 0 } + } else { + set own U } append abbrev $xabbrev set notes_used($vid) 1 } else { + set own M lappend note_missings [list $island $realname $vid] } + + lappend codel "$lock$own" $xabbrev lappend newnotes [list $vid $realname $owner $xabbrev] - - set kk "$island $abbrev" + set kk "$island [join $codel _]" upvar #0 count($kk) k if {![info exists k]} { set k 0 } incr k + + debug "CODED $kk $vid $realname" } set clipboard {} @@ -341,7 +389,7 @@ proc parse-clipboard {} { foreach vid [lsort [array names notes]] { if {![info exists notes_used($vid)]} { manyset $notes($vid) lno notename - note-info $lno $vid $notename \ + note-info $lno $vid $notename {} \ "vessel in notes no longer found" } } @@ -423,7 +471,10 @@ proc draw {} { foreach key [lsort [array names count]] { set c $count($key) # debug "SHOWING $key $c" - regexp {^(.*) (\S+)$} $key dummy islandname abbrev + regexp {^(.*) (\S+)$} $key dummy islandname code + + set abbrev [code2abbrev $code] + if {[string compare $lastislandname $islandname]} { manyset $isleloc($islandname) x y set x [coord $x] @@ -688,6 +739,8 @@ proc invoke_notes {} { #---------- main program ---------- +vesselclasses-init + parseargs argdefaults httpclientsetup where-vessels @@ -695,6 +748,10 @@ load-chart widgets-setup set notes_data {} +if {[catch { parse-clipboard } emsg]} { + puts stderr "$emsg\n$errorInfo" + exit 1 +} after idle invoke_notes draw