From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sun, 13 Dec 2009 17:07:45 +0000 (+0000)
Subject: where-vessels: filtering filters
X-Git-Tag: 6.3.2~1
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=commitdiff_plain;h=4e736b5638f21d0726da0c8776e26dae396e1e23

where-vessels: filtering filters
---

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index c382c6a..39d8306 100755
--- 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]} {