chiark / gitweb /
parameterise vessel class and subclass info ready for remote fetching; no behavioural...
[ypp-sc-tools.db-live.git] / yarrg / where-vessels
index b007a67b878ed873b4964f68554853b322110ed6..c5ec9b03ffec39e97ebf2d30a9421912e1145cb9 100755 (executable)
@@ -133,6 +133,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 +246,36 @@ proc display-note-infos {} {
 
 #---------- vessel properties ----------
 
-proc vesselclasses-init {} {
-    global vc_game2code vc_code2abbrev vc_code2full vc_codes
-    set vcl {
+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 vesselclasses-init {} {
+    global vc_game2code vc_code2abbrev vc_code2full vc_codes
+    global vessel_class_info vessel_subclass_info
     set vc_codes {}
-    foreach {game code abbrev full} $vcl {
+    foreach {game code abbrev full} $vessel_class_info {
+       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 +283,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} $vessel_subclass_info {
+       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} {
@@ -374,10 +400,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,11 +603,12 @@ proc vessel {vin} {
     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) }
+    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]/[ \
@@ -625,7 +653,7 @@ proc vessel {vin} {
     lappend newnotes [list $vid $realname $owner $xabbrev]
     set kk "$island [join $codel _]"
     upvar #0 found($kk) k
-    lappend k [list $vid $realname]
+    lappend k [list $vid $realname $owner]
  
     debug "CODED $kk $vid $realname"
 }
@@ -1079,8 +1107,20 @@ proc show-report {islandname code} {
     .cp.report.list delete 0 end
 
     foreach entry $k {
-       manyset $entry vid name
-       .cp.report.list insert end $name
+       manyset $entry vid name owner
+       lappend owned($owner) $name
+    }
+
+    foreach owner [lsort [array names owned]] {
+       if {[string length $owner]} {
+           set owndesc "$owner's"
+       } else {
+           set owndesc "Owner unknown"
+       }
+       .cp.report.list insert end "$owndesc:"
+       foreach name $owned($owner) {
+           .cp.report.list insert end " $name"
+       }
     }
 }