From: Ian Jackson Date: Sun, 8 Aug 2010 14:25:20 +0000 (+0100) Subject: where-vessels: generalised grid control machinery X-Git-Tag: 6.6.2~25 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=commitdiff_plain;h=82e1631405dbf48b91e3bd1f31d31d63395906fd where-vessels: generalised grid control machinery --- diff --git a/yarrg/where-vessels b/yarrg/where-vessels index d1ec483..57ab56a 100755 --- a/yarrg/where-vessels +++ b/yarrg/where-vessels @@ -337,7 +337,7 @@ proc canvas-horiz-stack {xvar xoff y bind type args} { 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 $bind return $id @@ -449,6 +449,51 @@ proc show-report-decode {code} { } } +#---------- 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 @@ -488,7 +533,7 @@ proc smash-code {code} { } 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} { @@ -532,6 +577,7 @@ proc filter-default/lockown {lockown} { 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 } @@ -562,32 +608,30 @@ proc filter-tickbox-flip {fil} { 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} { @@ -623,21 +667,10 @@ proc make-entry-filter {fil label def} { 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 {} { @@ -654,7 +687,6 @@ proc filterstyle-changed {n1 n2 op} { 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 { @@ -666,8 +698,12 @@ proc filters-say-yes {code} { } 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 } @@ -858,10 +894,27 @@ proc chart-got/league {x1 y1 x2 y2 kind} { } } -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] }