[PD-cvs] pd/src desire.tk,1.1.2.286,1.1.2.287
chunlee
chunlee at users.sourceforge.net
Sun Aug 6 04:54:47 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29772
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
first commit for the keyboard(ctrl+arrows) object navigation code
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.286
retrieving revision 1.1.2.287
diff -C2 -d -r1.1.2.286 -r1.1.2.287
*** desire.tk 5 Aug 2006 13:06:31 -0000 1.1.2.286
--- desire.tk 6 Aug 2006 02:54:44 -0000 1.1.2.287
***************
*** 444,447 ****
--- 444,451 ----
set key(popup_open) ""
set key(client_class_tree) "Ctrl+grave"
+ set key(key_nav_up) "Ctrl+up"
+ set key(key_nav_down) "Ctrl+down"
+ set key(key_nav_right) "Ctrl+right"
+ set key(key_nav_left) "Ctrl+left"
set accels {}
***************
*** 2333,2336 ****
--- 2337,2433 ----
}
+ def Canvas key_nav_up {} {$self key_nav "up"}
+ def Canvas key_nav_down {} {$self key_nav "down"}
+ def Canvas key_nav_right {} {$self key_nav "right"}
+ def Canvas key_nav_left {} {$self key_nav "left"}
+ def* Canvas key_nav {direction} {
+ if {[llength $@selection] == 1} {
+ set group ""
+ set distances ""
+ switch $direction {
+ up {
+
+ foreach item $@children {
+ if {$_($item:y1) < $_($@selection:y1)} {
+ if {$_($item:x1) >= $_($@selection:x1) && $_($item:x1) <= [expr $_($@selection:x1) + $_($@selection:xs)]} {
+ lappend group $item
+ lappend distances [expr abs ($_($item:y1) - $_($@selection:y1))]
+ }
+ set x2 [expr $_($item:x1) + $_($item:xs)]
+ if {$x2 >= $_($@selection:x1) && $x2 <= [expr $_($@selection:x1) + $_($@selection:xs)]} {
+ lappend group $item
+ lappend distances [expr abs($_($item:y1) - $_($@selection:y1))]
+ }
+ }
+ }
+ }
+ down {
+ foreach item $@children {
+ if {$_($item:y1) > $_($@selection:y1)} {
+ if {$_($item:x1) > $_($@selection:x1) && $_($item:x1) < [expr $_($@selection:x1) + $_($@selection:xs)]} {
+ lappend group $item
+ lappend distances [expr abs ($_($item:y1) - $_($@selection:y1))]
+ }
+ set x2 [expr $_($item:x1) + $_($item:xs)]
+ if {$x2 > $_($@selection:x1) && $x2 < [expr $_($@selection:x1) + $_($@selection:xs)]} {
+ lappend group $item
+ lappend distances [expr abs($_($item:y1) - $_($@selection:y1))]
+ }
+ }
+ }
+ }
+ right {
+ foreach item $@children {
+ if {$_($item:x1) > $_($@selection:x1)} {
+ if {$_($item:y1) >= $_($@selection:y1) && $_($item:y1) <= [expr $_($@selection:y1) + $_($@selection:ys)]} {
+ lappend group $item
+ lappend distances [expr abs ($_($item:x1) - $_($@selection:x1))]
+ }
+ set y2 [expr $_($item:y1) + $_($item:ys)]
+ if {$y2 >= $_($@selection:y1) && $y2 <= [expr $_($@selection:y1) + $_($@selection:ys)]} {
+ lappend group $item
+ lappend distances [expr abs($_($item:x1) - $_($@selection:x1))]
+ }
+ }
+ }
+
+ }
+ left {
+ foreach item $@children {
+ if {$_($item:x1) < $_($@selection:x1)} {
+ if {$_($item:y1) >= $_($@selection:y1) && $_($item:y1) <= [expr $_($@selection:y1) + $_($@selection:ys)]} {
+ lappend group $item
+ lappend distances [expr abs ($_($item:x1) - $_($@selection:x1))]
+ }
+ set y2 [expr $_($item:y1) + $_($item:ys)]
+ if {$y2 >= $_($@selection:y1) && $y2 <= [expr $_($@selection:y1) + $_($@selection:ys)]} {
+ lappend group $item
+ lappend distances [expr abs($_($item:x1) - $_($@selection:x1))]
+ }
+ }
+ }
+ }
+ }
+
+
+ if {[llength $group] > 0} {
+ set closest [lindex $distances 0]
+ for {set i 1} {$i<[llength $distances]} {incr i} {
+ set val [lindex $distances $i]
+ if {$val < $closest} {set closest [lindex $distances $i]}
+ }
+ set index [lsearch $distances $closest]
+ set next [lindex $group $index]
+ } else {
+ set next $@selection
+ }
+
+ $self deselect_all
+ $next selected?= 1
+ set @selection $next
+ }
+
+ }
+
#-----------------------------------------------------------------------------------#
set lastcanvasconfigured ""
***************
*** 2408,2411 ****
--- 2505,2509 ----
}
}
+ Escape {if {[llength $@selection] > 0} {$self deselect_all}}
default {}
}
More information about the Pd-cvs
mailing list