WIP icon display

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

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index ae8fb5520325066b134011566c178f5ed7650264..73f416a5beaa546c0fa6e0ed745289f2949d87ae 100755 (executable)
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -193,6 +193,15 @@ proc note-info {lno vid name island description} {
     lappend note_infos [list $lno $vid $name $island $description]
 }
 
+proc canvas-horiz-stack {xvar y type args} {
+    upvar 1 $xvar x
+    global canvas
+    set id [eval $canvas create $type $x $y $args]
+    set bbox [$canvas bbox $id]
+    set x [lindex $bbox 2]
+    return $id
+}
+
 proc display-note-infos {} {
     global note_infos note_missings notes
 
@@ -264,6 +273,7 @@ proc vesselclasses-init {} {
        set vc_game2code($game) $code
        set vc_code2abbrev($code) $abbrev
        set vc_code2full($code) $full
+       image create bitmap ship-icon/$abbrev -file icondir/$abbrev.xbm
     }
 }
 
@@ -647,6 +657,7 @@ proc redraw-needed {} {
 
 proc draw {} {
     global chart found isleloc canvas redraw_after
+    global vc_code2abbrev
 
     catch { after cancel $redraw_after }
     catch { unset redraw_after }
@@ -679,17 +690,33 @@ proc draw {} {
        set text $abbrev
        regsub -all {[0-9]} $text {} text
        if {$c > 1} {
-               set text [format "%2d%s" $c $text]
+           set qty [format "%2d" $c]
        } else {
-               set text [format "  %s" $text]
+           set qty [format "99" $c]
        }
-       set id [$canvas create text $x $y \
-               -anchor nw -font fixed \
-               -text $text]
-       set bbox [$canvas bbox $id]
-       set bid [eval $canvas create rectangle $bbox -fill white]
-       $canvas lower $bid $id
-       $canvas bind $id <ButtonPress> [list show-report $islandname $code]
+
+       set stackx $x
+       incr stackx 2
+       set tid [canvas-horiz-stack stackx $y \
+                text -anchor nw -font fixed -text $qty]
+       incr stackx -1
+       canvas-horiz-stack stackx [expr {$y+1}] \
+           image -anchor nw -image ship-icon/$vc_code2abbrev([lindex [split $code _] 1])
+       incr stackx
+       canvas-horiz-stack stackx $y \
+           text -anchor nw -font fixed -text $text
+               
+       set bbox [$canvas bbox $tid]
+       set ny [lindex $bbox 3]
+       puts "$tid $bbox"
+       set bid [$canvas create rectangle \
+                    $x $y $stackx $ny \
+                    -fill white]
+
+       set y $ny
+       $canvas lower $bid $tid
+
+       $canvas bind $tid <ButtonPress> [list show-report $islandname $code]
        $canvas bind $bid <ButtonPress> [list show-report $islandname $code]
        manyset $bbox dummy dummy dummy y
 #      debug "NEW Y $y"