pd/src desire.tk,1.1.2.600.2.411,1.1.2.600.2.412 - Pd-cvs

16 Oct 2007


      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"
    }
  }