pd/src desire.tk,1.1.2.346,1.1.2.347 - Pd-cvs

16 Aug 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]
  }