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

[ypp-sc-tools.db-test.git] / yarrg / where-vessels

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index a9c40a3e4ca3f3bb6f54be151bb9c2b5873f6414..0aa7290669881a22fc12e60ea08f38690907ff71 100755 (executable)
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -361,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
@@ -1093,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 {}
@@ -1400,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
 
@@ -1417,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]] {
@@ -1443,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} {