global vsc_game2code
set vsc_game2code(null) {}
set vsc_code2report() Ordinary
+ set vsc_code2report(!) "Special/L.E."
foreach {game code full} $subclassinfos {
if {![regexp {^[A-Z]$} $code code]} { error "bad code" }
set vsc_game2code($game) $code
}
}
+#---------- smashing ----------
+
+set smash_subclass 0
+
+proc smash-code {code} {
+ manyset [split $code _] inport class subclass lockown xabbrev
+
+ global smash_subclass
+ if {$smash_subclass && [string length $subclass]} {
+ set subclass !
+ }
+
+ return [join [list $inport $class $subclass $lockown $xabbrev] _]
+}
+
#---------- filtering ----------
set filters {}
}
proc draw {} {
- global chart found isleloc canvas redraw_after islandnames
+ global chart found isleloc canvas redraw_after islandnames smfound
catch { after cancel $redraw_after }
catch { unset redraw_after }
eval chart-got/$proc [lrange $l 1 end]
}
- set islandnames {}
- set lastislandname {}
+ catch { unset smfound }
foreach key [lsort [array names found]] {
- set c [llength $found($key)]
-# debug "SHOWING $key $c"
regexp {^(.*) (\S+)$} $key dummy islandname code
+ set smcode [smash-code $code]
+ debug "smashed $code => $smcode"
+ set smkey "$islandname $smcode"
+ foreach vessel $found($key) { lappend smfound($smkey) $vessel }
+ }
+
+ set islandnames {}
+ set lastislandname {}
+ foreach smkey [lsort [array names smfound]] {
+ set c [llength $smfound($smkey)]
+# debug "SHOWING $smkey $c"
+ regexp {^(.*) (\S+)$} $smkey dummy islandname code
if {![filters-say-yes $code]} continue
#----- control panels and filter -----
frame .cp
+ frame .smash -relief groove -bd 2 -padx 1
frame .filter -relief groove -bd 2 -padx 1
frame .islands -pady 2
- pack .cp .filter .islands -side top
+ pack .cp .smash .filter .islands -side top
+
+ label .smash.title -text Smash
+ pack .smash.title -side left
+
+ checkbutton .smash.subclass -text Subclass \
+ -variable smash_subclass -command redraw-needed
+ pack .smash.subclass -side left
set filterstyle 1
trace add variable filterstyle write filterstyle-changed
show-report-decode $code
set kk "$islandname $code"
- upvar #0 found($kk) k
+ upvar #0 smfound($kk) k
.cp.report.list delete 0 end