[PD-cvs] pd/src desire.tk,1.1.2.346,1.1.2.347
chunlee
chunlee at users.sourceforge.net
Wed Aug 16 02:37:04 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27574
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
puts the quadrant method into the previous key navigation codes
added the snap mode for the crosshair
fixed the wire connection via keys
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.346
retrieving revision 1.1.2.347
diff -C2 -d -r1.1.2.346 -r1.1.2.347
*** desire.tk 15 Aug 2006 21:07:50 -0000 1.1.2.346
--- desire.tk 16 Aug 2006 00:37:01 -0000 1.1.2.347
***************
*** 947,951 ****
set scale(canned) [list 25 33 50 75 100 125 150 200 250 300 400]
!
#-----------------------------------------------------------------------------------#
proc read_ddrc {} {
--- 947,952 ----
set scale(canned) [list 25 33 50 75 100 125 150 200 250 300 400]
! set crosshair(state) 1
! set crosshair(snap) 1
#-----------------------------------------------------------------------------------#
proc read_ddrc {} {
***************
*** 1205,1210 ****
}
def* Canvas editmodeswitch {args} {
set @editmode [expr !$@editmode]
! if {$@crosshair && !$@editmode} {$self hide_crosshair}
pd .$self editmode $@editmode
}
--- 1206,1212 ----
}
def* Canvas editmodeswitch {args} {
+ global crosshair
set @editmode [expr !$@editmode]
! if {$crosshair(state) && !$@editmode} {$self hide_crosshair}
pd .$self editmode $@editmode
}
***************
*** 1274,1278 ****
set @shift_wires {}
set @keynav_tab_sel "wire"
- set @crosshair 1
}
--- 1276,1279 ----
***************
*** 1920,1929 ****
}
! 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]
--- 1921,1930 ----
}
! def* Canvas quadrant {du dv array} {
switch $@keynav_current { 0 {set @keynav_current [lindex $@children 0]}}
set foo {}
set bar {}
set pos [$@keynav_current xy]
! foreach o $array {
mset {x y} [l- $pos [$o xy]]
set u [expr $x+$y]
***************
*** 1931,1946 ****
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 target} {
! global font canvas tooltip
set canvas(current) $self
set c .$self.c
! if {$@crosshair && $@editmode} {$self show_crosshair $x $y}
if {$tooltip(visible)} {
if {[expr [distance $tooltip(curpos) [list $x $y]] > 10]} {
--- 1932,1948 ----
if {$u*$du>0 && $v*$dv>0} {lappend foo $o; lappend bar [distance $pos [$o xy]]}
}
! if {![llength $bar]} {return $@keynav_current}
set best [lindex $foo [lsearch_minimum $bar]]
! return $best
! #set @keynav_current $best
! #$self selection= $best
}
#!@#$ this method is too long
def* Canvas motion {x y f target} {
! global font canvas tooltip crosshair
set canvas(current) $self
set c .$self.c
! if {$crosshair(state) && $@editmode} {$self show_crosshair $x $y $target}
if {$tooltip(visible)} {
if {[expr [distance $tooltip(curpos) [list $x $y]] > 10]} {
***************
*** 1978,1983 ****
outlet {set port [$id hilite_io o $x $y]; set @dehighlight [list $c delete ${id}o${port}b]}
object {
! if {$@editmode} {set event motionedit} {set event motion}
! $id $event $x $y $f $target
}
wire {}
--- 1980,1985 ----
outlet {set port [$id hilite_io o $x $y]; set @dehighlight [list $c delete ${id}o${port}b]}
object {
! #if {$@editmode} {set event motionedit} {set event motion}
! #$id $event $x $y $f $target
}
wire {}
***************
*** 2449,2460 ****
}
! def Canvas key_nav_up {} {$self key_nav "up" 0}
! def Canvas key_nav_down {} {$self key_nav "down" 0}
! def Canvas key_nav_right {} {$self key_nav "right" 0}
! def Canvas key_nav_left {} {$self key_nav "left" 0}
! def Canvas key_nav_up_shift {} {$self key_nav "up" 1}
! def Canvas key_nav_down_shift {} {$self key_nav "down" 1}
! def Canvas key_nav_right_shift {} {$self key_nav "right" 1}
! def Canvas key_nav_left_shift {} {$self key_nav "left" 1}
# intervals
--- 2451,2462 ----
}
! def Canvas key_nav_up {} {$self key_nav +1 -1 0}
! def Canvas key_nav_down {} {$self key_nav -1 +1 0}
! def Canvas key_nav_right {} {$self key_nav -1 -1 0}
! def Canvas key_nav_left {} {$self key_nav +1 +1 0}
! def Canvas key_nav_up_shift {} {$self key_nav +1 -1 1}
! def Canvas key_nav_down_shift {} {$self key_nav -1 +1 1}
! def Canvas key_nav_right_shift {} {$self key_nav -1 -1 1}
! def Canvas key_nav_left_shift {} {$self key_nav +1 +1 1}
# intervals
***************
*** 2462,2507 ****
proc overlap {y0 y1 x0 x1} {return [expr [inside $y0 $x0 $x1] || [inside $y1 $x0 $x1]]}
! def* Canvas key_nav {direction shift} {
set group ""
set distances ""
switch $@keynav_tab_sel {
object {
! set @keynav_next [$self find_neighbor_obj $@keynav_current $direction]
}
wire {
! set find [lsearch $@wires $@keynav_current]
! set all [lreplace $@wires $find $find]
! mset {x1 y1 x2 y2} [$@keynav_current bbox]
! set obj1 $_($@keynav_current:obj1)
! set inlets [$obj1 ninlets]
! set outlets [$obj1 noutlets]
! set outlet_wire {}
! set inlet_wire {}
! for {set i 0} {$i<$outlets} {incr i} {lappend outlet_wire $i}
! for {set i 0} {$i<$inlets} {incr i} {lappend inlet_wire $i}
! puts "outlet_wire::: $outlet_wire"
! puts "inlet_wire::: $inlet_wire"
! puts "wire $@keynav_current comes from $obj1"
! puts "and it has wires::: $_($obj1:wires)"
! foreach wire $_($obj1:wires) {
! set wire_info [$wire report]
! set find [lsearch $wire_info $obj1]
! if {$find == 0} {
! set new [linsert [lindex $outlet_wire [lindex $wire_info 1]] 0 $wire]
! set outlet_wire [lreplace $outlet_wire [lindex $wire_info 1] [lindex $wire_info 1] $new]
! } else {
! set new [linsert [lindex $inlet_wire [lindex $wire_info 3]] 0 $wire]
! set inlet_wire [lreplace $inlet_wire [lindex $wire_info 3] [lindex $wire_info 3] $new]
! }
! }
! puts "outlet_wire::: $outlet_wire"
! puts "inlet_wire::: $inlet_wire"
! }
}
if {!$shift} {
! set find [lsearch $@selection $@keynav_current]
! set @selection [lreplace $@selection $find $find]
$@keynav_current selected?= 0
}
--- 2464,2512 ----
proc overlap {y0 y1 x0 x1} {return [expr [inside $y0 $x0 $x1] || [inside $y1 $x0 $x1]]}
! def* Canvas key_nav {du dv shift} {
set group ""
set distances ""
switch $@keynav_tab_sel {
object {
! set @keynav_next [$self quadrant $du $dv $@children]
}
wire {
! set @keynav_next [$self quadrant $du $dv $@wires]
! #set find [lsearch $@wires $@keynav_current]
! #set all [lreplace $@wires $find $find]
! #mset {x1 y1 x2 y2} [$@keynav_current bbox]
! #set obj1 $_($@keynav_current:obj1)
! #set inlets [$obj1 ninlets]
! #set outlets [$obj1 noutlets]
! #set outlet_wire {}
! #set inlet_wire {}
! #for {set i 0} {$i<$outlets} {incr i} {lappend outlet_wire $i}
! #for {set i 0} {$i<$inlets} {incr i} {lappend inlet_wire $i}
! #puts "outlet_wire::: $outlet_wire"
! #puts "inlet_wire::: $inlet_wire"
! #puts "wire $@keynav_current comes from $obj1"
!
! #puts "and it has wires::: $_($obj1:wires)"
! #foreach wire $_($obj1:wires) {
! # set wire_info [$wire report]
! # set find [lsearch $wire_info $obj1]
! # if {$find == 0} {
! # set new [linsert [lindex $outlet_wire [lindex $wire_info 1]] 0 $wire]
! # set outlet_wire [lreplace $outlet_wire [lindex $wire_info 1] [lindex $wire_info 1] $new]
! # } else {
! # set new [linsert [lindex $inlet_wire [lindex $wire_info 3]] 0 $wire]
! # set inlet_wire [lreplace $inlet_wire [lindex $wire_info 3] [lindex $wire_info 3] $new]
! # }
! #}
! #puts "outlet_wire::: $outlet_wire"
! #puts "inlet_wire::: $inlet_wire"
! }
}
if {!$shift} {
! #set find [lsearch $@selection $@keynav_current]
! #set @selection [lreplace $@selection $find $find]
! $self selection-= $@keynav_current
$@keynav_current selected?= 0
}
***************
*** 2562,2566 ****
--- 2567,2573 ----
set var [lindex $@keynav_iosel end end]
if {[lsearch $@keynav_iosel $@selection] < 0} {lappend @keynav_iosel $@selection; set @keynav_iocount 0}
+ puts " iosel::: $@keynav_iosel"
if {$@keynav_port != 0 && $@keynav_current == $var } {set hilitebox $@keynav_port;.$self.c delete ${hilitebox}b}
+ puts " keynav_port::: $@keynav_port"
set obj $@selection
#"$self$which $self$which$i $self"
***************
*** 2586,2590 ****
#set _($@selection:ioselect) [lindex $ports $@keynav_iocount]
set _($@selection:ioselect) [list [lindex $ports3 $@keynav_iocount] [lindex $ports2 $@keynav_iocount]]
! $obj hilite_io [lindex $ports2 $@keynav_iocount] $x $y
incr @keynav_iocount
--- 2593,2597 ----
#set _($@selection:ioselect) [lindex $ports $@keynav_iocount]
set _($@selection:ioselect) [list [lindex $ports3 $@keynav_iocount] [lindex $ports2 $@keynav_iocount]]
! $obj hilite_io [lindex $ports2 $@keynav_iocount] [expr $x/$@scale] [expr $y/$@scale]
incr @keynav_iocount
***************
*** 2762,2766 ****
# type is i or o
! def Box hilite_io {type x y} {
mset {x1 y1 x2 y2} [$self bbox]
set xs [expr $x2-$x1]
--- 2769,2773 ----
# type is i or o
! def* Box hilite_io {type x y} {
mset {x1 y1 x2 y2} [$self bbox]
set xs [expr $x2-$x1]
***************
*** 2825,2828 ****
--- 2832,2841 ----
}
+ def Wire xy {} {
+ set obj1 $@obj1
+ mset {x1 y1 x2 y2} [$obj1 xy]
+ list $x1 $y1
+ }
+
def Wire report {} {
list $@obj1 $@port1 $@obj2 $@port2
***************
*** 4336,4355 ****
############ crosshair
! def Canvas show_crosshair {x y} {
set width [expr [winfo width .$self.c] * (1/$@scale)]
set height [expr [winfo height .$self.c] * (1/$@scale)]
set off [expr 7 * (1/$@scale)]
! #puts "off ::: $off"
! set v1 [list $x 0 $x [expr $y - $off]]
! set h1 [list 0 $y [expr $x - $off] $y]
! set v2 [list $x [expr $y + $off] $x $height]
! set h2 [list [expr $x + $off] $y $width $y]
! set eye [list [expr $x - $off] [expr $y - $off] [expr $x + $off] [expr $y + $off]]
! #puts "vertical ::: $vertical"
! #puts "eye ::: $eye"
! $self item VHAIR1 line $v1 -fill [look objectfg] -width 0.5 -dash {4 4 4 4}
! $self item HHAIR1 line $h1 -fill [look objectfg] -width 0.5 -dash {4 4 4 4}
! $self item VHAIR2 line $v2 -fill [look objectfg] -width 0.5 -dash {4 4 4 4}
! $self item HHAIR2 line $h2 -fill [look objectfg] -width 0.5 -dash {4 4 4 4}
$self item EYE oval $eye -dash {4 4 4 4} -outline [look selrect]
}
--- 4349,4393 ----
############ crosshair
! def Canvas show_crosshair {x y target} {
! global crosshair
set width [expr [winfo width .$self.c] * (1/$@scale)]
set height [expr [winfo height .$self.c] * (1/$@scale)]
set off [expr 7 * (1/$@scale)]
! mset {type id detail} $target
! #puts " type::: $type id:::$id"
! #puts " action::: $@action"
!
! if {$crosshair(snap)} {
! if {$type == "object" | $type == "outlet" | $type == "inlet"} {
! if {$id != $self} {
! mset {x1 y1 x2 y2} [$id bbox]
! set X $x1; set Y $y1
! set crosshair(follow) $id
! } else {
! set X $x; set Y $y
! }
! } else {
! if {$@action == "move" | $@action == "edit"} {
! mset {x1 y1 x2 y2} [$crosshair(follow) bbox]
! set X $x1; set Y $y1
! } else {
! set X $x; set Y $y
! }
! }
! } else {
! set X $x; set Y $y
! }
!
! set v1 [list $X 0 $X [expr $Y - $off]]
! set h1 [list 0 $Y [expr $X - $off] $Y]
! set v2 [list $X [expr $Y + $off] $X $height]
! set h2 [list [expr $X + $off] $Y $width $Y]
! set eye [list [expr $X - $off] [expr $Y - $off] [expr $X + $off] [expr $Y + $off]]
!
!
! $self item VHAIR1 line $v1 -fill [look selectframe] -width 0.5 -dash {4 4 4 4}
! $self item HHAIR1 line $h1 -fill [look selectframe] -width 0.5 -dash {4 4 4 4}
! $self item VHAIR2 line $v2 -fill [look selectframe] -width 0.5 -dash {4 4 4 4}
! $self item HHAIR2 line $h2 -fill [look selectframe] -width 0.5 -dash {4 4 4 4}
$self item EYE oval $eye -dash {4 4 4 4} -outline [look selrect]
}
More information about the Pd-cvs
mailing list