where-vessels: filtering filters

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index c382c6a4b92f913218c2e6c73e40401723a19feb..39d83064fecf99d7c58700adc6d4810a43e7b7fb 100755 (executable)
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -327,23 +327,14 @@ proc show-report-decode {code} {
 
 set filters {}
 
-#proc make-size-filter {minmax minmaxdesc} {
-#    set n [llength $vc_codes]
-#    $w configure 
-
-#    make-filter size${minmax} "$minmaxdesc size" scale \
-#      [list \
-#           -tickinterval 0 \
-#           -variable filter_size{$minmax} \
-#           -from 0 -to [expr {$n-1}] \
-#           -resolution 1 \
-#           -length [expr {$n*5}] \
-#           ]
-
-
 proc filter-values/size {} { global vc_codes; return $vc_codes }
 proc filter-map/size {code} { upvar #0 vc_code2abbrev($code) abb; return $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} {
@@ -357,6 +348,12 @@ proc filter-map/lockown {lockown} { return [code2abbrev-lock $lockown] }
 proc filter-default/lockown {lockown} {
     return [regexp {^[01]|^2[^1]} $lockown]
 }
+proc filter-says-yes/lockown {codel} {
+    set lockown [lindex $codel 3]
+    regsub -all {\D} $lockown X lockown
+    upvar #0 filter_lockown($lockown) yes
+    return $yes
+}
 
 proc filter-validate/xabbre {re} {
     if {[catch {
@@ -368,6 +365,11 @@ proc filter-validate/xabbre {re} {
     }
     return {}
 }
+proc filter-says-yes/xabbre {codel} {
+    global filter_xabbre
+    set xabbrev [lindex $codel 4]
+    return [regexp -- $filter_xabbre $xabbrev]
+}
 
 proc filter-tickbox-flip {fil} {
     upvar #0 filter_$fil vars
@@ -375,7 +377,7 @@ proc filter-tickbox-flip {fil} {
     foreach val $values {
        set vars($val) [expr {!$vars($val)}]
     }
-    refilter-needed
+    redraw-needed
 }
 
 proc make-tickbox-filter {fil label rows inrow} {
@@ -392,7 +394,7 @@ proc make-tickbox-filter {fil label rows inrow} {
        set vars($val) [filter-default/$fil $val]
        checkbutton $fw.$ix -variable filter_${fil}($val) \
            -text [filter-map/$fil $val] -font fixed \
-           -command refilter-needed
+           -command redraw-needed
        grid configure $fw.$ix -sticky sw \
            -row [expr {$ix / $inrow}] \
            -column [expr {$ix % $inrow}]
@@ -417,7 +419,7 @@ proc entry-filter-changed {fw fil n1 n2 op} {
        } else {
            $fw.error configure -text { } -background $def_background
            set realvar $entryvar
-           refilter-needed
+           redraw-needed
        }
     } emsg]} {
        puts stderr "FILTER CHECK ERROR $emsg $errorInfo"
@@ -437,15 +439,11 @@ proc make-entry-filter {fil label def} {
     pack $fw.entry $fw.error -side top -anchor w
 }
 
-proc refilter-needed {} {
-    debug "REFILTER NEEDED"
-}
-
 proc make-filter {kind fil label ekind} {
     global filters
     label .filter.lab_$fil -text $label -justify left
     $ekind .filter.$fil
-    lappend filters [list $kind $fil]
+    lappend filters $fil
     set nfilters [llength $filters]
     grid configure .filter.lab_$fil -row $nfilters -column 0 -sticky nw -pady 4
     grid configure .filter.$fil -row $nfilters -column 1 -sticky w -pady 3
@@ -457,6 +455,15 @@ proc make-filters {} {
     make-tickbox-filter lockown "Lock/\nowner" 2 6
     make-entry-filter xabbre "Flags\n regexp" {}
 }
+
+proc filters-say-yes {code} {
+    global filters
+    debug "filters-say-yes $code"
+    foreach fil $filters {
+       if {![filter-says-yes/$fil [split $code _]]} { return 0 }
+    }
+    return 1
+}
     
 #---------- loading and parsing the clipboard (vessel locations) ----------
 
@@ -631,8 +638,18 @@ proc chart-got/league {x1 y1 x2 y2 kind} {
        }
 }
 
+proc redraw-needed {} {
+    global redraw_after
+    debug "REDRAW NEEDED"
+    if {[info exists redraw_after]} return
+    set redraw_after [after 250 draw]
+}
+
 proc draw {} {
-    global chart found isleloc canvas
+    global chart found isleloc canvas redraw_after
+
+    catch { after cancel $redraw_after }
+    catch { unset redraw_after }
     
     $canvas delete all
 
@@ -648,6 +665,8 @@ proc draw {} {
 #      debug "SHOWING $key $c"
        regexp {^(.*) (\S+)$} $key dummy islandname code
 
+       if {![filters-say-yes $code]} continue
+
        set abbrev [code2abbrev $code]
        
        if {[string compare $lastislandname $islandname]} {