pd/src desire.tk,1.1.2.516,1.1.2.517 - Pd-cvs

19 Oct 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]