+#---------- 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-gridded-control .smash $sma $label $ekind]
+}
+
+proc make-radio-smasher {sma label variable descs} {
+ set w [make-smasher $sma $label frame]
+ for {set i 0} {$i < [llength $descs]} {incr i} {
+ radiobutton $w.v$i \
+ -variable $variable -value $i -command redraw-needed \
+ -text [lindex $descs $i]
+ pack $w.v$i -side left
+ }
+}
+