[PD-cvs] pd/src desire.tk,1.1.2.343,1.1.2.344
Mathieu Bouchard
matju at users.sourceforge.net
Tue Aug 15 19:47:26 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12443
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
Alt+arrows use quadrant-based navigation
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.343
retrieving revision 1.1.2.344
diff -C2 -d -r1.1.2.343 -r1.1.2.344
*** desire.tk 15 Aug 2006 16:49:57 -0000 1.1.2.343
--- desire.tk 15 Aug 2006 17:47:23 -0000 1.1.2.344
***************
*** 1885,1888 ****
--- 1885,1926 ----
}
+ def Canvas altkey {key iso shift} {
+ switch $key {
+ Up { $self quadrant +1 -1; return }
+ Down { $self quadrant -1 +1; return }
+ Left { $self quadrant +1 +1; return }
+ Right { $self quadrant -1 -1; return }
+ }
+ super $key $iso $shift
+ }
+
+ proc lsearch_minimum {l} {
+ set i 0
+ set j 0
+ set min [lindex $l 0]
+ foreach o $l {
+ if {$o < $min} {set i $j; set min $o}
+ incr j
+ }
+ return $i
+ }
+
+ def* Canvas quadrant {du dv} {
+ switch $@keynav_current { 0 {set @keynav_current [lindex $@children 0]}}
+ set foo {}
+ set bar {}
+ set pos [$@keynav_current xy]
+ foreach o $@children {
+ mset {x y} [l- $pos [$o xy]]
+ set u [expr $x+$y]
+ set v [expr $x-$y]
+ if {$u*$du>0 && $v*$dv>0} {lappend foo $o; lappend bar [distance $pos [$o xy]]}
+ }
+ if {![llength $bar]} {return}
+ set best [lindex $foo [lsearch_minimum $bar]]
+ set @keynav_current $best
+ $self selection= $best
+ }
+
#!@#$ this method is too long
def* Canvas motion {x y f} {
More information about the Pd-cvs
mailing list