chiark / gitweb /
where-vessels: generalised grid control machinery
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 8 Aug 2010 14:25:20 +0000 (15:25 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 8 Aug 2010 19:59:50 +0000 (20:59 +0100)
yarrg/where-vessels

index d1ec483..57ab56a 100755 (executable)
@@ -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 <ButtonPress> $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]
 }