+#---------- 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
+set smash_owner 0
+
+proc smash-code {code} {
+ manyset [split $code _] inport class subclass lockown xabbrev
+
+ global smash_subclass
+ if {$smash_subclass > 1} {
+ set subclass {}
+ } elseif {$smash_subclass && [string length $subclass]} {
+ set subclass !
+ }
+
+ global smash_owner
+ switch $smash_owner {
+ 0 { }
+ 1 { regsub {[12]$} $lockown 5 lockown }
+ 2 {
+ if {[regexp {^0.} $lockown]} {
+ # battle ready / all lock states
+ set lockown 03
+ } elseif {[regexp {^.0} $lockown]} {
+ # not battle ready / yours
+ set lockown 40
+ } else {
+ # state (not battle ready) / not known to be yours
+ regsub {.$} $lockown 4 lockown
+ }
+ }
+ 3 { regsub {.$} $lockown {3} lockown }
+ 4 { set lockown 33 }
+ }
+
+ return [join [list $inport $class $subclass $lockown $xabbrev] _]
+}
+
+proc make-smasher {sma label ekind} {
+ return [make-control .smash $sma $label $ekind]
+}
+
+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} {
+ make-control-grid-entry $w ix $i \
+ radiobutton \
+ -variable $variable -value $i -command redraw-needed \
+ -text [lindex $descs $i]
+ }
+}
+