upvar 1 canvas canvas
set id [eval $canvas create $type [expr {$x+$xoff}] $y $args]
set bbox [$canvas bbox $id]
- debug "CANVAS-HORIZ-STACK $type $x $xoff $id $bbox [list $args]"
+# debug "CANVAS-HORIZ-STACK $type $x $xoff $id $bbox [list $args]"
set x [lindex $bbox 2]
$canvas bind $id <ButtonPress> $bind
return $id
}
}
+#---------- common to smashing and filtering ----------
+
+proc make-control {parent ctrl label ekind} {
+ debug "MAKE-CONTROL [list $parent $ctrl $label $ekind]"
+ label $parent.lab_$ctrl -text $label -justify left
+ $ekind $parent.$ctrl
+ manyset [grid size $parent] dummy row
+ incr row
+ grid configure $parent.lab_$ctrl -row $row -column 0 -sticky nw -pady 4
+ grid configure $parent.$ctrl -row $row -column 1 -sticky w -pady 3
+ return $parent.$ctrl
+}
+
+proc begin-control-grid {cw count rows inrow} {
+ if {!$inrow} { set inrow [expr {($count + $rows) / $rows}] }
+ upvar #0 control_grid_properties($cw) props
+ set props [list $rows $inrow]
+ return $cw
+}
+
+proc make-control-grid-entry {cw kind ix ekind args} {
+ upvar #0 control_grid_properties($cw) props
+ manyset $props rows inrow
+
+ set ew $cw.$ix
+ eval [list $ekind $ew] $args
+
+ switch -exact $kind {
+ ix {
+ grid configure $ew -sticky sw \
+ -row [expr {$ix / $inrow}] \
+ -column [expr {$ix % $inrow}]
+ }
+ final {
+ grid configure $ew -sticky se \
+ -row [expr {$rows-1}] \
+ -column [expr {$inrow-1}]
+ }
+ default {
+ error "$kind ?"
+ }
+ }
+ return $ew
+}
+
#---------- smashing ----------
set smash_subclass 0
}
proc make-smasher {sma label ekind} {
- return [make-gridded-control .smash $sma $label $ekind]
+ return [make-control .smash $sma $label $ekind]
}
-proc make-radio-smasher {sma label variable descs} {
+proc make-radio-smasher {sma label variable descs rows inrow} {
set w [make-smasher $sma $label frame]
+ begin-control-grid $w [llength $descs] $rows $inrow
for {set i 0} {$i < [llength $descs]} {incr i} {
- radiobutton $w.v$i \
+ make-control-grid-entry $w ix $i \
+ radiobutton \
-variable $variable -value $i -command redraw-needed \
-text [lindex $descs $i]
- pack $w.v$i -side left
}
}
proc filter-says-yes/lockown {codel} {
set lockown [lindex $codel 3]
upvar #0 filter_lockown($lockown) yes
+ debug "FILTER-SAYS-YES/LOCKOWN $codel $lockown $yes"
return $yes
}
proc make-tickbox-filter {fil label rows inrow} {
upvar #0 filter_$fil vars
- set fw [make-filter $fil $label frame]
set values [filter-values/$fil]
- set nvalues [llength $values]
- if {!$inrow} {
- set inrow [expr {($nvalues + $rows) / $rows}]
- }
+ set count [llength $values]
set noicons [catch { info args filter-icon/$fil }]
- for {set ix 0} {$ix < $nvalues} {incr ix} {
+
+ set fw [make-filter $fil $label frame]
+ begin-control-grid $fw $count $rows $inrow
+
+ for {set ix 0} {$ix < $count} {incr ix} {
set val [lindex $values $ix]
set vars($val) [filter-default/$fil $val]
- checkbutton $fw.$ix -variable filter_${fil}($val) \
- -font fixed -command redraw-needed
+ set ew [make-control-grid-entry $fw ix $ix checkbutton \
+ -variable filter_${fil}($val) \
+ -font fixed \
+ -command [list redraw-needed tickbox-filter $fil $val]]
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}]
}
- button $fw.invert -text flip -command [list filter-tickbox-flip $fil] \
+ [make-control-grid-entry $fw final invert button] \
+ configure \
+ -text flip -command [list filter-tickbox-flip $fil] \
-padx 0 -pady 0
- grid configure $fw.invert -sticky se \
- -row [expr {$rows-1}] \
- -column [expr {$inrow-1}]
}
proc entry-filter-changed {fw fil n1 n2 op} {
pack $fw.entry $fw.error -side top -anchor w
}
-proc make-gridded-control {parent name label ekind} {
- debug "MAKE-GRIDDED-CONTROL [list $parent $name $label $ekind]"
- label $parent.lab_$name -text $label -justify left
- $ekind $parent.$name
- manyset [grid size $parent] dummy row
- incr row
- grid configure $parent.lab_$name -row $row -column 0 -sticky nw -pady 4
- grid configure $parent.$name -row $row -column 1 -sticky w -pady 3
- return $parent.$name
-}
-
proc make-filter {fil label ekind} {
global filters
lappend filters $fil
- return [make-gridded-control .filter $fil $label $ekind]
+ return [make-control .filter $fil $label $ekind]
}
proc make-filters {} {
proc filters-say-yes {code} {
global filters filterstyle
- debug "filters-say-yes $code"
set codel [split $code _]
set lockown [lindex $codel 3]
switch -exact $filterstyle {
}
foreach fil $filters {
- if {![filter-says-yes/$fil $codel]} { return 0 }
+ if {![filter-says-yes/$fil $codel]} {
+ debug "FILTERS-SAY-YES $code NO $fil"
+ return 0
+ }
}
+ debug "FILTERS-SAY-YES $code YES $filters"
return 1
}
}
}
-proc redraw-needed {} {
+proc debug-filter-array {array} {
+ upvar #0 $array a
+ set m " FILTER $array"
+ foreach k [lsort [array names a]] {
+ append m " $k=$a($k)"
+ }
+ debug $m
+}
+
+proc redraw-needed {args} {
global redraw_after
- debug "REDRAW NEEDED"
+ debug "REDRAW NEEDED $args"
if {[info exists redraw_after]} return
+
+ global filterstyle
+ debug " FILTER style $filterstyle"
+ debug-filter-array filter_size
+ debug-filter-array filter_lockown
+ global filter_xabbre
+ debug " FILTER xabbre $filter_xabbre"
+
set redraw_after [after 250 draw]
}
proc widgets-setup {} {
global canvas debug pirate ocean filterstyle
- wm geometry . 1024x600
+ wm geometry . 1200x800
wm title . "where-vessels - $pirate on the $ocean ocean"
#----- map -----
grid .smash.title -row 0 -column 0 -columnspan 2
make-radio-smasher subclass Subclass smash_subclass \
- {Show Normal/LE Hide}
+ {Show Normal/LE Hide} 1 0
make-radio-smasher owner Owner smash_owner \
- {Show Yours? You Lock Hide}
+ {Show Yours? {For you} Lock Hide} 2 3
set filterstyle 1
trace add variable filterstyle write filterstyle-changed
~yarrgweb / ypp-sc-tools.main.git / blobdiff