[PD-cvs] pd/src desire.tk,1.1.2.516,1.1.2.517

chunlee chunlee at users.sourceforge.net
Thu Oct 19 14:01:52 CEST 2006


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
also tidied up Canvas motion and unclick brok them down to smaller defs


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.516
retrieving revision 1.1.2.517
diff -C2 -d -r1.1.2.516 -r1.1.2.517
*** desire.tk	19 Oct 2006 02:08:25 -0000	1.1.2.516
--- desire.tk	19 Oct 2006 12:01:49 -0000	1.1.2.517
***************
*** 2299,2313 ****
  	global font canvas tooltip crosshair
  	set c [$self widget]
! 	if {[$self look hairstate] && $@editmode} {
! 		$@crosshair data= $x $y $target
! 		$@crosshair draw
! 	} else {
! 		$@crosshair erase
! 	}
! 	if {[$self look tooltip]} {
! 		if {[expr [distance $tooltip(curpos) [list $x $y]] > 10]} {
! 			$self hide_tooltip
! 		}
! 	}
  	eval $@dehighlight
  	set @dehighlight {}
--- 2299,2303 ----
  	global font canvas tooltip crosshair
  	set c [$self widget]
! 	$self motion_checkhairtip $target $x $y
  	eval $@dehighlight
  	set @dehighlight {}
***************
*** 2320,2347 ****
  	mset {type id detail} $target
  	switch $@action {
! 		move {
! 			mset {ox oy} $oldpos
! 			foreach obj $@selection {
! 				if {[[$obj class] <= Box]} {
! 					$obj move [expr $x-$ox] [expr $y-$oy]
! 				} else {
! 					puts "Canvas motion warning: trying to move non-Box explicitly"
! 				}
! 			}
! 			return
! 		}
! 		edit {
! 			if {[distance [list $x $y] $@click_at] > 5} {
! 				foreach obj $@selection {
! 					if {[[$obj class] <= Box]} {
! 						$obj backupxy= [$obj xy]
! 					} else {
! 						puts "Canvas motion warning: trying to backup coordinates of non-Box"
! 					}
! 				}
! 				set @action move
! 				mset {ox oy} $@click_at
! 			}
! 		}
  		insert {}
  		chain_obj {}
--- 2310,2315 ----
  	mset {type id detail} $target
  	switch $@action {
! 		move {$self motion_move $oldpos $x $y; return}
! 		edit {$self motion_edit $x $y}
  		insert {}
  		chain_obj {}
***************
*** 2350,2353 ****
--- 2318,2367 ----
  	}
  	if {$id == ""} {return}
+ 	$self motion_iohilite $target $x $y
+ }
+ 
+ def Canvas motion_move {oldpos x y} {
+ 	mset {ox oy} $oldpos
+ 	foreach obj $@selection {
+ 		if {[[$obj class] <= Box]} {
+ 			$obj move [expr $x-$ox] [expr $y-$oy]
+ 		} else {
+ 			puts "Canvas motion warning: trying to move non-Box explicitly"
+ 		}
+ 	}
+ }
+ 
+ def Canvas motion_edit {x y} {
+ 	if {[distance [list $x $y] $@click_at] > 5} {
+ 		foreach obj $@selection {
+ 			if {[[$obj class] <= Box]} {
+ 				$obj backupxy= [$obj xy]
+ 			} else {
+ 				puts "Canvas motion warning: trying to backup coordinates of non-Box"
+ 			}
+ 		}
+ 		set @action move
+ 		mset {ox oy} $@click_at
+ 	}
+ }
+ 
+ def Canvas motion_checkhairtip {target x y} {
+ 	global crosshair tooltip
+ 	if {[$self look hairstate] && $@editmode} {
+ 		$@crosshair data= $x $y $target
+ 		$@crosshair draw
+ 	} else {
+ 		$@crosshair erase
+ 	}
+ 	if {[$self look tooltip]} {
+ 		if {[expr [distance $tooltip(curpos) [list $x $y]] > 10]} {
+ 			$self hide_tooltip
+ 		}
+ 	}
+ }
+ 
+ def Canvas motion_iohilite {target x y} {
+ 	set c [$self widget]
+ 	mset {type id detail} $target
  	if {$@editmode && [$id canvas] == $self} {
  		switch $type {
***************
*** 2581,2587 ****
  	set @selection {}
  	set @selection_wire {}
- 	#if {$@selection_wire != ""} {
- 	#foreach wire $@selection_wire {$wire selected?= 0}
- 	#}
  }
  
--- 2595,2598 ----
***************
*** 2647,2653 ****
  def Canvas auto_wire {} {
  	$self clear_wires
- 	#set obj1_idx [$self children_idx $@auto_wire_obj1]
- 	#set obj2_idx [$self children_idx $@auto_wire_obj2]
- 	#$self connect [list $obj1_idx 0 $obj2_idx 0]
  	foreach obj1 $@auto_wire_obj1 {
  		set idx1 [$self children_idx $obj1]
--- 2658,2661 ----
***************
*** 2686,2693 ****
  	set @canvas $canvas
  	mset {type from port} $target
- 	#set @from $from
- 	#set @outlet $port
- 	#set @to ""
- 	#set @inlet ""
  	switch $type {
  	outlet {
--- 2694,2697 ----
***************
*** 2901,2917 ****
  		switch $@action {
  			edit {set @obj_in_edit $id; $id edit; set @action none; $id changed}
! 			move {
! 				foreach obj $@selection {
! 					if {![[$obj class] <= Box]} {
! 						puts "Canvas unclick warning: trying to move non-Box explicitly"
! 						continue
! 					}
! 					mset {x1 y1} [$obj xy]
! 					$obj position= [$obj backupxy]
! 					$obj moveto $x1 $y1
! 				}
! 				set objs $@selection
! 				set @action none
! 			}
  			none {}
  			insert {}
--- 2905,2909 ----
  		switch $@action {
  			edit {set @obj_in_edit $id; $id edit; set @action none; $id changed}
! 			move {$self unclick_move}
  			none {}
  			insert {}
***************
*** 2919,2931 ****
  			default {$@action unclick $x $y $f $target}
  		}
! 	} else {
! 		if {[$self focus] != ""} {[$self focus] unclick $x $y $f $target}
! 		mset {type id detail} $target
! 		if {$id != ""} {if {[$id class] == "Array"} {$id unclick $x $y $f $target; return}}
! 	}
  	$self adjust_scrollbars
  	$self checkgeometry
  }
  
  def Canvas adjust_scrollbars {} {
      set c [$self widget]
--- 2911,2941 ----
  			default {$@action unclick $x $y $f $target}
  		}
! 	} else {$self unclick_runmode $target $f $x $y}
  	$self adjust_scrollbars
  	$self checkgeometry
  }
  
+ def Canvas unclick_move {} {
+ 	foreach obj $@selection {
+ 		if {![[$obj class] <= Box]} {
+ 			puts "Canvas unclick warning: trying to move non-Box explicitly"
+ 			continue
+ 		}
+ 		mset {x1 y1} [$obj xy]
+ 		$obj position= [$obj backupxy]
+ 		$obj moveto $x1 $y1
+ 	}
+ 	set objs $@selection
+ 	set @action none
+ }
+ 
+ def Canvas unclick_runmode {target f x y} {
+ 	if {[$self focus] != ""} {[$self focus] unclick $x $y $f $target}
+ 	mset {type id detail} $target
+ 	if {$id != ""} {
+ 		if {[$id class] == "Array"} {$id unclick $x $y $f $target; return}
+ 	}
+ }
+ 
  def Canvas adjust_scrollbars {} {
      set c [$self widget]





More information about the Pd-cvs mailing list