where-vessels: show unsmashed code canvas for vessel when we click on the name in...

[ypp-sc-tools.web-live.git] / yarrg / where-vessels

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 78342db3076a63e490a13c0a050bc6e6e687c47c..0aa7290669881a22fc12e60ea08f38690907ff71 100755 (executable)
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -263,7 +263,7 @@ proc display-note-infos {} {
        $infodata
 }
 
-#---------- vessel properties ----------
+#---------- vessel info and icons ----------
 
 proc info-cache-update {} {
     global info_source info_cache
@@ -339,6 +339,8 @@ proc load-icon-combine {args} {
     image create bitmap icon/[join $args +] -data [exec bash -c $cmd]
 }
 
+#---------- vessel properties ----------
+
 proc code-lockown2icon {lockown} {
     manyset [split $lockown ""] lock notown
     set l "
@@ -359,6 +361,13 @@ proc canvas-horiz-stack {xvar xoff y bind type args} {
     return $id
 }
 
+proc code2canvas1 {code canvas} {
+    set y 2
+    code2canvas $code $canvas 5 y {} 0 {}
+    manyset [$canvas bbox all] minx dummy maxx dummy
+    $canvas configure -width [expr {$maxx-$minx+4}]
+}
+
 proc code2canvas {code canvas x yvar qty qtylen bind} {
     global vc_code2abbrev
     upvar 1 $yvar y
@@ -1091,7 +1100,9 @@ proc draw {} {
        set smcode [smash-code $code]
        debug "smashed $code => $smcode"
        set smkey "$islandname $smcode"
-       foreach vessel $found($key) { lappend smfound($smkey) $vessel }
+       foreach vessel $found($key) {
+           lappend smfound($smkey) [list $vessel $code]
+       }
     }
 
     set islandnames {}
@@ -1398,8 +1409,12 @@ proc widgets-setup {} {
 
     listbox .cp.report.list -height 5
 
+    canvas .cp.report.abbrev1 -width 1 -height 15
+
     pack .cp.report.island .cp.report.abbrev .cp.report.details \
-       .cp.report.list -side top
+       .cp.report.list .cp.report.abbrev1 -side top
+    bind .cp.report.list <<ListboxSelect>> show-report-abbrev1
+
     #pack .cp.report.code -side top
     pack configure .cp.report.details -fill x
 
@@ -1415,22 +1430,22 @@ proc show-report {islandname code} {
     .cp.report.island configure -text $islandname
 
     .cp.report.abbrev delete all
-    set y 2
-    code2canvas $code .cp.report.abbrev 5 y {} 0 {}
-    manyset [.cp.report.abbrev bbox all] minx dummy maxx dummy
-    .cp.report.abbrev configure -width [expr {$maxx-$minx+4}]
+    code2canvas1 $code .cp.report.abbrev
 
     glset report_code $code
     show-report-decode $code
 
     set kk "$islandname $code"
-    upvar #0 smfound($kk) k
+    upvar #0 smfound($kk) vessels
 
+    global report_list_codes
+    set report_list_codes {}
     .cp.report.list delete 0 end
 
-    foreach elem $k {
+    foreach foundelem $vessels {
+       manyset $foundelem elem code
        manyset $elem vid name owner
-       lappend owned($owner) $name
+       lappend owned($owner) [list $name $code]
     }
 
     foreach owner [lsort [array names owned]] {
@@ -1441,11 +1456,31 @@ proc show-report {islandname code} {
        }
        if {[have-notes]} {
            .cp.report.list insert end "$owndesc:"
+           lappend report_list_codes {}
        }
-       foreach name $owned($owner) {
+       foreach ownelem $owned($owner) {
+           manyset $ownelem name code
            .cp.report.list insert end " $name"
+           lappend report_list_codes $code
        }
     }
+    show-report-abbrev1
+}
+
+proc show-report-abbrev1 {} {
+    global report_list_codes
+    .cp.report.abbrev1 delete all
+    set ix [.cp.report.list curselection]
+    debug "SHOW-REPORT-ABBREV1 $ix $report_list_codes"
+    if {[llength $ix] != 1} return
+    set code [lindex $report_list_codes $ix]
+    if {![string length $code]} return
+    if {![have-notes]} {
+       manyset [split $code _] inport size subclass lockown xabbrev
+       regsub {.$} $lockown 3 lockown
+       set code [join [list $inport $size $subclass $lockown $xabbrev] _]
+    }
+    code2canvas1 $code .cp.report.abbrev1
 }
 
 proc zoom {amt} {