[PD-cvs] pd/src desire.tk,1.1.2.600.2.411,1.1.2.600.2.412

[chunlee]

Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2720

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
identify_target tweak


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.411
retrieving revision 1.1.2.600.2.412
diff -C2 -d -r1.1.2.600.2.411 -r1.1.2.600.2.412
*** desire.tk	15 Oct 2007 15:58:11 -0000	1.1.2.600.2.411
--- desire.tk	16 Oct 2007 14:54:21 -0000	1.1.2.600.2.412
***************
*** 3011,3015 ****
  		$self motion $x $y $f [$self identify_target $x $y $f]
  	}
! 	set @motion_after_id [after 50 "$self motion_update"]
  }
  
--- 3011,3015 ----
  		$self motion $x $y $f [$self identify_target $x $y $f]
  	}
! 	set @motion_after_id [after 100 "$self motion_update"]
  }
  
***************
*** 3065,3069 ****
  
  def Canvas motion {x y f target} {
! 	modes_callback $self "motion" $x $y $f $target
  	set c [$self widget]
  	$self motion_checkhairtip $target $x $y
--- 3065,3069 ----
  
  def Canvas motion {x y f target} {
! 	#modes_callback $self "motion" $x $y $f $target
  	set c [$self widget]
  	$self motion_checkhairtip $target $x $y
***************
*** 3089,3093 ****
  	if {$@editmode} {$self motion_iohilite2 $x $y $f}
  	if {$id == ""} {return}
- 	#$self motion_iohilite $target $x $y
  }
  
--- 3089,3092 ----
***************
*** 3248,3306 ****
  	set cx [expr $x*$@zoom]
  	set cy [expr $y*$@zoom]
- 	#doesn't do anything yet
- 	#if {$@action != "none"} {set range 2} else {set range 2}
  	set stack [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]
- 
  	# reversing the stack is necessary for some things
  	# not reversing the stack is also necessary for some other things
  	# we have to figure out something.
  	set stack [lreverse $stack]
! 	foreach tag $stack {
! 		set tags [$c gettags $tag]
! 		if {[regexp {^[xo][0-9a-f]{6,8}} $tags id]} {
! 			# prior to Aug 15th, Wires had lower priority as all objects together
! 			# now it's same priority, so just stacking order (and it's prolly wrong)
! 			set class [$id class]
! 			if {[$self == $id]} {continue}
! 			if {[$class <= Wire]} {if {$@action != "imove"} {return [list "wire" $id]}}
! 			if {[$class <= Box]} {
! 				if {$@action == "imove"} {
! 					foreach tag $stack {
! 						set tags2 [$c gettags $tag]
! 						if {[regexp {^[xo][0-9a-f]{6,8}} $tags2 id2]} {
! 							set class [$id2 class]
! 							if {[$class == Wire]} {return [list "wire" $id2]}
! 						}
! 					}
! 				}
! 				mset {x1 y1 x2 y2} [$id bbox]
! 				if {[regexp {^x[0-9a-f]{6,8}LABEL} $tags label]} {
! 					if {$x>$x1 && $x<$x2 && $y>$y1 && $y<$y2} {
! 						return [list "object" $id]
! 					} else {
! 						return [list "label" $id]
  					}
  				}
! 				set outs [$id noutlets]
! 				set  ins [$id  ninlets]
! 				if {$y>=$y2-6 && $outs} {
! 					set val [expr int(($x-$x1)*$outs/($x2-$x1))]
! 					if {$val == $outs} {set val [expr $val-1]}
! 					return [list "outlet" $id $val]
! 				}
! 				if {$y< $y1+2 &&  $ins} {
! 					set val [expr int(($x-$x1)* $ins/($x2-$x1))]
! 					if {$val == $ins} {set val [expr $val-1]}
! 					return [list  "inlet" $id $val]
  				}
- 				return [list "object" $id]
  			}
! 			#puts "skipped a $class"
  		}
  	}
- 	foreach tag $stack {
- 		set tags [$c gettags $tag]
- 	}
- 	return [list "nothing"]
  }
  
--- 3247,3306 ----
  	set cx [expr $x*$@zoom]
  	set cy [expr $y*$@zoom]
  	set stack [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]
  	# reversing the stack is necessary for some things
  	# not reversing the stack is also necessary for some other things
  	# we have to figure out something.
  	set stack [lreverse $stack]
! 	set target ""
! 	foreach tag $stack {set target [$self target $x $y $f $tag]; if {[llength $target] > 1} {break}}
! 	if {[llength $target] > 1} {return $target} {return [list "nothing"]}
! }
! 
! def Canvas target {x y f tag} {
! 	set c [$self widget]
! 	set cx [expr $x*$@zoom]
! 	set cy [expr $y*$@zoom]
! 	set tags [$c gettags $tag]
! 	if {[regexp {^[xo][0-9a-f]{6,8}} $tags id]} {
! 		# prior to Aug 15th, Wires had lower priority as all objects together
! 		# now it's same priority, so just stacking order (and it's prolly wrong)
! 		if {[$id classtags] == ""} {return [list "nothing"]}
! 		set class [$id class]
! 		if {[$self == $id]} {continue}
! 		if {[$class <= Wire]} {if {$@action != "imove"} {return [list "wire" $id]}}
! 		if {[$class <= Box]} {
! 			if {$@action == "imove"} {
! 				foreach tag $stack {
! 					set tags2 [$c gettags $tag]
! 					if {[regexp {^[xo][0-9a-f]{6,8}} $tags2 id2]} {
! 						set class [$id2 class]
! 						if {[$class == Wire]} {return [list "wire" $id2]}
  					}
  				}
! 			}
! 			mset {x1 y1 x2 y2} [$id bbox]
! 			if {[regexp {^x[0-9a-f]{6,8}LABEL} $tags label]} {
! 				if {$x>$x1 && $x<$x2 && $y>$y1 && $y<$y2} {
! 					return [list "object" $id]
! 				} else {
! 					return [list "label" $id]
  				}
  			}
! 			set outs [$id noutlets]
! 			set  ins [$id  ninlets]
! 			if {$y>=$y2-6 && $outs} {
! 				set val [expr int(($x-$x1)*$outs/($x2-$x1))]
! 				if {$val == $outs} {set val [expr $val-1]}
! 				return [list "outlet" $id $val]
! 			}
! 			if {$y< $y1+2 &&  $ins} {
! 				set val [expr int(($x-$x1)* $ins/($x2-$x1))]
! 				if {$val == $ins} {set val [expr $val-1]}
! 				return [list  "inlet" $id $val]
! 			}
! 			return [list "object" $id]
  		}
+ 		#puts "skipped a $class"
  	}
  }