[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