set vc_game2code($game) $code
set vc_code2abbrev($code) $abbrev
set vc_code2full($code) $full
+ image create bitmap ship-icon/$abbrev -file icons/$abbrev.xbm
}
}
append abbrev [lindex {= - ?} [regsub {\D} $notown 2]]
}
-proc code2abbrev {code} {
+proc canvas-horiz-stack {xvar y bind type args} {
+ upvar 1 $xvar x
+ upvar 1 canvas canvas
+ set id [eval $canvas create $type $x $y $args]
+ set bbox [$canvas bbox $id]
+ set x [lindex $bbox 2]
+ $canvas bind $id <ButtonPress> $bind
+ return $id
+}
+
+proc code2canvas {code canvas x yvar qty qtylen bind} {
global vc_code2abbrev
+ upvar 1 $yvar y
manyset [split $code _] inport class subclass lockown xabbrev
- set abbrev {}
- append abbrev [lindex {? {}} $inport]
- append abbrev $vc_code2abbrev($class)
- append abbrev $subclass
- append abbrev [code2abbrev-lock $lockown]
- append abbrev $xabbrev
+ set stackx $x
+ incr stackx 2
+
+ append qty [lindex {? {}} $inport]
+ set qty [format "%${qtylen}s" $qty]
+
+ set qtyid [canvas-horiz-stack stackx $y $bind \
+ text -anchor nw -font fixed -text $qty]
+
+ incr stackx -1
+ canvas-horiz-stack stackx [expr {$y+2}] $bind \
+ image -anchor nw -image ship-icon/$vc_code2abbrev($class)
+ incr stackx
- debug "CODE2ABBREV $code $abbrev"
- return $abbrev
+ canvas-horiz-stack stackx $y $bind \
+ text -anchor nw -font fixed -text \
+ "$subclass[code2abbrev-lock $lockown]$xabbrev"
+
+ set bbox [$canvas bbox $qtyid]
+ set ny [lindex $bbox 3]
+ set bid [$canvas create rectangle \
+ $x $y $stackx $ny \
+ -fill white]
+
+ set y $ny
+ $canvas lower $bid $qtyid
+
+ $canvas bind $bid <ButtonPress> $bind
}
proc show-report-decode {code} {
set filters {}
proc filter-values/size {} { global vc_codes; return $vc_codes }
-proc filter-map/size {code} { upvar #0 vc_code2abbrev($code) abb; return $abb }
+proc filter-icon/size {code} {
+ upvar #0 vc_code2abbrev($code) abb
+ return ship-icon/$abb
+}
proc filter-default/size {code} { return 1 }
proc filter-says-yes/size {codel} {
set sizecode [lindex $codel 1]
if {!$inrow} {
set inrow [expr {($nvalues + $rows) / $rows}]
}
-
+ set noicons [catch { info args filter-icon/$fil }]
for {set ix 0} {$ix < $nvalues} {incr ix} {
set val [lindex $values $ix]
set vars($val) [filter-default/$fil $val]
checkbutton $fw.$ix -variable filter_${fil}($val) \
- -text [filter-map/$fil $val] -font fixed \
- -command redraw-needed
+ -font fixed -command redraw-needed
+ if {!$noicons} {
+ $fw.$ix configure -image [filter-icon/$fil $val] -height 16
+ } else {
+ $fw.$ix configure -text [filter-map/$fil $val]
+ }
grid configure $fw.$ix -sticky sw \
-row [expr {$ix / $inrow}] \
-column [expr {$ix % $inrow}]
if {![filters-say-yes $code]} continue
- set abbrev [code2abbrev $code]
-
if {[string compare $lastislandname $islandname]} {
manyset $isleloc($islandname) x y
set x [coord $x]
set lastislandname $islandname
# debug "START Y $y"
}
- set text $abbrev
- regsub -all {[0-9]} $text {} text
- if {$c > 1} {
- set text [format "%2d%s" $c $text]
- } else {
- set text [format " %s" $text]
- }
- 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]
- $canvas bind $bid <ButtonPress> [list show-report $islandname $code]
- manyset $bbox dummy dummy dummy y
+
+ if {$c > 1} { set qty [format %d $c] } else { set qty {} }
+ code2canvas $code $canvas $x y $qty 2 \
+ [list show-report $islandname $code]
# debug "NEW Y $y"
}
label .cp.report.island -text { }
- frame .cp.report.abbrev -background black
- glset report_abbrev { }
- entry .cp.report.abbrev.abbrev -state readonly \
- -textvariable report_abbrev \
- -borderwidth 0 -relief flat -width 0 \
- -highlightbackground white \
- -readonlybackground white -foreground black
- pack .cp.report.abbrev.abbrev -side left -padx 1 -pady 1
+ canvas .cp.report.abbrev -width 1 -height 15
frame .cp.report.code
label .cp.report.code.lab -text Code:
proc show-report {islandname code} {
.cp.report.island configure -text $islandname
- glset report_code $code
- glset report_abbrev [code2abbrev $code]
+ .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}]
+
+ glset report_code $code
show-report-decode $code
set kk "$islandname $code"