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
set vc_game2code($game) $code
set vc_code2abbrev($code) $abbrev
set vc_code2full($code) $full
- image create bitmap ship-icon/$abbrev -file iconsdir/$abbrev.xbm
+ 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]
- debug "CODE2ABBREV $code $abbrev"
- return $abbrev
+ incr stackx -1
+ canvas-horiz-stack stackx [expr {$y+2}] $bind \
+ image -anchor nw -image ship-icon/$vc_code2abbrev($class)
+ incr stackx
+
+ 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}]
proc draw {} {
global chart found isleloc canvas redraw_after
- global vc_code2abbrev
catch { after cancel $redraw_after }
catch { unset redraw_after }
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 qty [format "%2d" $c]
- } else {
- set qty [format "99" $c]
- }
- 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
+ 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"
~yarrgweb / ypp-sc-tools.db-live.git / blobdiff