+ }
+ return $ew
+}
+
+proc control-tickbox-flip {varsvn values} {
+ upvar #0 $varsvn vars
+ foreach val $values {
+ set vars($val) [expr {!$vars($val)}]
+ }
+ redraw-needed c.-tickbox-flip $varsvn $values
+}
+
+proc populate-control-grid-tickboxes {cw rows inrow varsvn values flipvalues
+ label_kind valvn default_get label_get} {
+ debug "POPULATE-CONTROL-GRID-TICKBOXES $cw $rows $inrow $varsvn\
+ [list $values] $label_kind $valvn"
+
+ upvar #0 $varsvn vars
+ upvar 1 $valvn val
+ set count [llength $values]
+
+ begin-control-grid $cw $count $rows $inrow
+
+ for {set ix 0} {$ix < $count} {incr ix} {
+ set val [lindex $values $ix]
+ set vars($val) [uplevel 1 $default_get]
+ set ew [make-control-grid-elem $cw ix $ix checkbutton \
+ -variable ${varsvn}($val) \
+ -font fixed \
+ -command [list redraw-needed c.-g.-tickbox $cw $val]]
+ $ew configure -$label_kind [uplevel 1 $label_get]
+ switch -exact $label_kind {
+ image { $ew configure -height 16 }
+ }
+ }
+ [make-control-grid-elem $cw final invert button] \
+ configure \
+ -text flip -command [list control-tickbox-flip $varsvn $flipvalues] \
+ -padx 0 -pady 0
+}
+
+#---------- smashing ----------
+
+proc smash-code {code} {
+ manyset [split $code _] inport size subclass lockown xabbrev
+
+ upvar #0 smash_sizemap($size) smsize
+
+ 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 }
+ }
+
+ global smash_xabbrev_map
+ set xabbrev [string map $smash_xabbrev_map $xabbrev]
+
+ return [join [list $inport $smsize $subclass $lockown $xabbrev] _]
+}
+
+proc smash-prepare {} {
+ global vc_codes smash_sizemap smash_size smash_sizeinexact
+ set mapto {}
+ catch { unset smash_sizeplus }
+ foreach size $vc_codes {
+ if {!$smash_size($size)} {
+ set mapto $size
+ } else {
+ set smash_sizeinexact($mapto) 1
+ }
+ set smash_sizemap($size) $mapto
+ }
+
+ global smash_xabbrev_a smash_xabbrev_b smash_xabbrev_map
+ set smash_xabbrev_map {}
+ foreach a [split $smash_xabbrev_a ""] b [split $smash_xabbrev_b ""] {
+ if {![string length $a]} continue
+ lappend smash_xabbrev_map $a $b
+ }
+ debug "SMASH-PREPAE xabbrev_map=[list $smash_xabbrev_map]"
+}
+
+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-elem $w ix $i \
+ radiobutton \
+ -variable $variable -value $i -command redraw-needed \
+ -text [lindex $descs $i]
+ }
+}
+
+proc make-smashers {} {
+ global vc_codes vc_code2abbrev
+ set cw [make-smasher size "Size\n round\n down" frame]
+ populate-control-grid-tickboxes $cw 2 0 smash_size \
+ $vc_codes [lrange $vc_codes 1 end] \
+ image val { expr 0 } { expr {"icon/$vc_code2abbrev($val)"} }
+ $cw.0 configure -state disabled
+
+ glset smash_subclass 0
+ make-radio-smasher subclass Class smash_subclass \
+ {Show Normal/LE Hide} 1 0
+
+ global no_owners
+ glset smash_owner [expr {$no_owners ? 3 : 0}]
+ make-radio-smasher owner Owner smash_owner \
+ {Show Yours? {For you} Lock Hide} 2 3
+
+ set cw [make-smasher xabbrev "Flags" frame]
+ foreach ix {1 3} ab {a b} width {14 12} {
+ set vn smash_xabbrev_$ab
+ global $vn
+ set $vn {}
+ entry $cw.$ix -textvariable $vn -width $width
+ trace add variable $vn write [list redraw-needed $vn]
+ }
+ set ix 0
+ foreach str {y/ / /d} { label $cw.$ix -text $str; incr ix 2 }
+ eval pack [lsort [winfo children $cw]] -side left
+}
+
+#---------- filtering ----------
+
+set filters {}
+
+proc filter-values/size {} { global vc_codes; return $vc_codes }
+proc filter-icon/size {code} {
+ upvar #0 vc_code2abbrev($code) abb
+ return icon/$abb
+}
+proc filter-default/size {code} { return 1 }
+proc filter-says-yes/size {codel} {
+ set sizecode [lindex $codel 1]
+ upvar #0 filter_size($sizecode) yes
+ return $yes
+}
+
+proc filter-values/lockown {} {
+ foreach lv {0 1 2} {
+ foreach ov {0 1 2} {
+ lappend vals "$lv$ov"
+ }
+ }
+ return $vals
+}
+proc filter-icon/lockown {lockown} { return [code-lockown2icon $lockown] }
+proc filter-default/lockown {lockown} {
+ return [regexp {^[01]|^2[^1]} $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
+}
+
+proc filter-validate/xabbre {re} {
+ if {[catch {
+ regexp -- $re {}
+ } emsg]} {
+ regsub {^.*:\s*} $emsg {} emsg
+ regsub {^.*(.{30})$} $emsg {\1} emsg
+ return $emsg
+ }
+ return {}
+}
+proc filter-says-yes/xabbre {codel} {
+ global filter_xabbre
+ set xabbrev [lindex $codel 4]
+ return [regexp -- $filter_xabbre $xabbrev]
+}
+
+proc make-tickbox-filter {fil label rows inrow} {
+ set values [filter-values/$fil]
+
+ if {![catch { info args filter-icon/$fil }]} {
+ set label_get { filter-icon/$fil $val }
+ set label_kind image
+ } else {
+ set label_get { filter-map/$fil $val }
+ set label_kind text
+ }
+
+ set fw [make-filter $fil $label frame]
+
+ populate-control-grid-tickboxes $fw $rows $inrow filter_$fil \
+ $values $values \
+ $label_kind val { filter-default/$fil $val } $label_get
+}
+
+proc entry-filter-changed {fw fil n1 n2 op} {
+ global errorInfo
+ upvar #0 filter_$fil realvar
+ upvar #0 filterentered_$fil entryvar
+ global def_background
+ debug "entry-filter-changed $fw $fil $entryvar"
+ if {[catch {
+ set error [filter-validate/$fil $entryvar]
+ if {[string length $error]} {
+ $fw.error configure -text $error -foreground white -background red
+ } else {
+ $fw.error configure -text { } -background $def_background
+ set realvar $entryvar
+ redraw-needed
+ }
+ } emsg]} {
+ puts stderr "FILTER CHECK ERROR $emsg $errorInfo"
+ }
+}
+
+proc make-entry-filter {fil label def} {
+ global filterentered_$fil
+ upvar #0 filter_$fil realvar
+ set realvar $def
+ set fw [make-filter $fil $label frame]
+ entry $fw.entry -textvariable filterentered_$fil
+ label $fw.error
+ glset def_background [$fw.error cget -background]
+ trace add variable filterentered_$fil write \
+ [list entry-filter-changed $fw $fil]
+ pack $fw.entry $fw.error -side top -anchor w
+}
+
+proc make-filter {fil label ekind} {
+ global filters
+ lappend filters $fil
+ return [make-control .filter $fil $label $ekind]
+}
+
+proc make-filters {} {
+ make-tickbox-filter size Size 2 0
+ make-tickbox-filter lockown "Lock/\nowner" 2 6
+ make-entry-filter xabbre "Flags\n regexp" {}
+}
+
+proc filterstyle-changed {n1 n2 op} {
+ global filterstyle
+ debug "filterstyle-changed $filterstyle"
+ redraw-needed
+}
+
+proc filters-say-yes {code} {
+ global filters filterstyle
+ set codel [split $code _]
+ set lockown [lindex $codel 3]
+ switch -exact $filterstyle {
+ 0 { return 1 }
+ 1 { return [filter-default/lockown $lockown] }
+ 2 { return [regexp {^.0} $lockown] }
+ 3 { }
+ default { error $filterstyle }
+ }
+
+ foreach fil $filters {
+ if {![filter-says-yes/$fil $codel]} {
+ debug "FILTERS-SAY-YES $code NO $fil"
+ return 0
+ }
+ }
+ debug "FILTERS-SAY-YES $code YES $filters"
+ return 1
+}
+
+#---------- loading and parsing the clipboard (vessel locations) ----------
+
+proc vessel {vin} {
+ global pirate notes_used note_missings newnotes
+ upvar 1 $vin vi
+
+ set codel {}
+ lappend codel [errexpect-arrayget-boolean vi inPort]
+
+ set gamesize [errexpect-arrayget vi vesselClass]
+ upvar #0 vc_game2code($gamesize) size
+ if {![info exists size]} {
+ set size "($gamesize)"
+ upvar #0 vc_code2abbrev($size) vcabb
+ set vcabb vc-$size
+ set data [exec pbmtext -builtin fixed " $gamesize " \
+ | pnminvert | pnmcrop | pbmtoxbm]
+ debug "INVENTED ICON $vcabb $data"
+ image create bitmap icon/$vcabb -data $data
+
+ global vc_code2full
+ set vc_code2full($size) "Type \"$gamesize\""
+ }
+ lappend codel $size
+
+ set gamesubclass [errexpect-arrayget vi vesselSubclass]
+ upvar #0 vsc_game2code($gamesubclass) subclass
+ if {[info exists subclass]} {
+ lappend codel $subclass
+ } else {
+ lappend codel ($gamesubclass)
+ }
+
+ switch -exact [errexpect-arrayget vi isLocked]/[ \
+ errexpect-arrayget vi isBattleReady] {
+ true/false { set lock 2 }
+ false/false { set lock 1 }
+ false/true { set lock 0 }
+ default { errexpect-error "unexpected isLocked/isBattleReady" }
+ }
+
+ set vid [errexpect-arrayget vi vesselId]
+ upvar #0 notes($vid) note
+ set realname [errexpect-arrayget vi vesselName]
+ set island [errexpect-arrayget vi islandName]
+
+ set owner {}
+ set xabbrev {}
+ if {[info exists note]} {
+ manyset $note lno notename owner xabbrev
+ if {[string compare -nocase $realname $notename]} {
+ note-info $lno $vid $realname $island \
+ "notes say name is $notename"
+ }
+ if {[string length $owner]} {