[PD-cvs] pd/src desire.tk,1.1.2.507,1.1.2.508

chunlee chunlee at users.sourceforge.net
Sun Oct 15 13:57:54 CEST 2006


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
auto object insert 


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.507
retrieving revision 1.1.2.508
diff -C2 -d -r1.1.2.507 -r1.1.2.508
*** desire.tk	14 Oct 2006 14:46:45 -0000	1.1.2.507
--- desire.tk	15 Oct 2006 11:57:51 -0000	1.1.2.508
***************
*** 1605,1608 ****
--- 1605,1635 ----
  }
  
+ def Canvas insert_object {} {
+ 	if {[llength $@selection_wire] == 1} {
+ 		puts "insert object for $@selection_wire"
+ 		#<- .x82aa1d8 obj 243.0 147.0;
+ 		mset {obj1 outlet obj2 inlet} [$@selection_wire report]
+ 		puts " $obj1 $outlet ----> $obj2 $inlet"
+ 		set c [$self widget]
+ 		set iowidth [$self look iowidth]
+ 		mset {ox1 oy1 ox2 oy2} [lmap / [$c bbox ${obj1}o${outlet}] [$self zoom]]
+ 		mset {ix1 iy1 ix2 iy2} [lmap / [$c bbox ${obj2}i${inlet}] [$self zoom]]
+ 		set x1 [expr $ox1 + ($iowidth / 2)]
+ 		set y1 [expr ($oy1 + $oy2) / 2]
+ 		set x2 [expr $ix1 + ($iowidth / 2)]
+ 		set y2 [expr ($iy1 + $iy2) / 2]
+ 		set x [expr (abs($x2-$x1) / 2) + $x1]
+ 		set y [expr (abs($y2-$y1) / 2) + $y1]
+ #		$c create oval [list [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] \
+ #		    -fill blue -tags "POO"
+ 		pd .$self "obj" $x $y
+ 		set @action insert
+ 		puts "  action ::: $@action"
+ 	} else {
+ 		return
+ 	}
+ }
+ 
+ 
  def Canvas Object  {} {$self new_object obj}
  def Canvas Message {} {$self new_object msg; global canvas; set canvas(msg_isnew) 1} ;# ???
***************
*** 1802,1806 ****
  	mset {cx cy} [$self xy]
  	$self item text window [list [expr $cx+2] [expr $cy+2]] \
! 		-window $t -anchor nw -tags "${self}text $self"
  	$t configure -pady 0 -padx 1
  	$t insert 1.0 $@text
--- 1829,1833 ----
  	mset {cx cy} [$self xy]
  	$self item text window [list [expr $cx+2] [expr $cy+2]] \
! 		-window $t -anchor nw -tags "${self}text $self text"
  	$t configure -pady 0 -padx 1
  	$t insert 1.0 $@text
***************
*** 1967,1974 ****
--- 1994,2014 ----
  	pd .$@canvas text_setto !$self $l
  	$self changed
+ 	if {[$@canvas action] == "insert"} {
+ 		set wire [$@canvas selection_wire]
+ 		set wire2 [$@canvas get_wire $wire]
+ 		mset {obj1 outlet obj2 inlet} [$wire report]
+ 		$@canvas disconnect $wire2
+ 		set obj1_idx [$@canvas children_idx $obj1]
+ 		set obj2_idx [$@canvas children_idx $obj2]
+ 		set obj3_idx [$@canvas children_idx $self]
+ 		$@canvas connect [list $obj1_idx $outlet $obj3_idx 0]
+ 		$@canvas connect [list $obj3_idx 0 $obj2_idx $inlet]
+ 		$@canvas action= none
+ 	}
  }
  
  def TextBox unedit {{accept 1}} {
  	if {!$@edit} {return}
+ 	if {!$accept} {$@canvas del [$@canvas children_idx $self]}
  	set @edit 0
  	set c [$@canvas widget]
***************
*** 2020,2023 ****
--- 2060,2065 ----
  def Canvas children {} {return $@children}
  
+ def Canvas children_idx {obj} {return [lsearch $@children $obj]}
+ 
  # think of the children!!!
  # should be only called from the server
***************
*** 2092,2095 ****
--- 2134,2144 ----
  def Canvas wires {} {return $@wires}
  
+ def Canvas get_wire {wire} {
+ 	set find [lsearch $@wires_pair $wire]
+ 	if {$find != -1} {
+ 		return [lindex $@wires_pair [expr $find -1]]
+ 	}
+ }
+ 
  def Canvas delete_selection {} {
  	if {![llength $@selection] && ![llength $@selection_wire]} {return}
***************
*** 2250,2253 ****
--- 2299,2303 ----
  			}
  		}
+ 		insert {}
  		none {}
  		default {$@action motion $x $y $f $target}
***************
*** 2354,2357 ****
--- 2404,2408 ----
  def Canvas statusbar_draw {x y} {$@statusbar draw $x $y}
  def Canvas action {} {return $@action}
+ def Canvas action= {action} {set @action $action} 
  def Canvas zoom {} {return $@zoom}
  
***************
*** 2512,2516 ****
  	$@history add [list $self    connect $wire]
  }
! def Canvas    connect {wire} {
  	mset {from outlet to inlet} $wire; pd .$self    connect $from $outlet $to $inlet
  	$@history add [list $self disconnect $wire]
--- 2563,2567 ----
  	$@history add [list $self    connect $wire]
  }
! def Canvas connect {wire} {
  	mset {from outlet to inlet} $wire; pd .$self    connect $from $outlet $to $inlet
  	$@history add [list $self disconnect $wire]
***************
*** 2601,2605 ****
  }
  def FutureWire draw {} {
! 	$self item WIRE line [xys $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [$self look dash] -smooth yes
  }
  
--- 2652,2656 ----
  }
  def FutureWire draw {} {
! 	$self item WIRE line [list $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [$self look dash] -smooth yes
  }
  
***************
*** 2737,2740 ****
--- 2788,2792 ----
  		move {}
  		none {}
+ 		insert {}
  		default {$@action unclick $x $y $f $target}
        		}
***************
*** 2748,2779 ****
  
  def Canvas unclick {x y f target} {
!     set c [$self widget]
!     mset {type id detail} $target
!     if {$@editmode} {
!       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 {}
! 	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
  }
  
--- 2800,2832 ----
  
  def Canvas unclick {x y f target} {
! 	set c [$self widget]
  	mset {type id detail} $target
! 	if {$@editmode} {
! 		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 {}
! 			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
  }
  
***************
*** 3129,3173 ****
  
  def Canvas key {x y key iso shift} {
!     $self hide_tooltip
!     if {[$self focus] != ""} {
! 	[$self focus] key $key $shift
!     }
!     #if {$iso != ""} {scan $iso %c key}
!     if {$shift} {set motion 10} {set motion 1}
!     switch -regexp -- $key {
! 	BackSpace|Delete|KP_Delete {$self delete_selection}
! 	Up    {if {[llength $@selection]} {$self selection_move 0 -$motion} else {$self scroll y -$motion}}
! 	Down  {if {[llength $@selection]} {$self selection_move 0 +$motion} else {$self scroll y +$motion}}
! 	Left  {if {[llength $@selection]} {$self selection_move -$motion 0} else {$self scroll x -$motion}}
! 	Right {if {[llength $@selection]} {$self selection_move +$motion 0} else {$self scroll x +$motion}}
! 	Tab   {$self tab_jump}
! 	Return {
! 	  if {[llength $@selection] == 1} {
! 	    if {[llength $@keynav_iosel] < 2} {
! 	    	if {$_($@selection:_class) == "ObjectBox"} {$@selection edit; $self dehilite_io}
! 	    } else {
! 		set from_obj [lindex $@keynav_iosel 0]
! 		set to_obj   [lindex $@keynav_iosel 1]
! 		set from   [lsearch $@children [lindex $@keynav_iosel 0]]
! 		set inlet  [lindex $_($from_obj:ioselect) 0]
! 		set to     [lsearch $@children [lindex $@keynav_iosel 1]]
! 		set outlet [lindex $_($to_obj:ioselect) 0]
! 		pd .$self connect [list $from $inlet $to $outlet]
! 		$self dehilite_io
! 	    }
! 	  }
  	}
! 	Escape {
! 	    if {[llength $@selection] > 0 | [llength $@selection_wire] > 0} {
! 		$self deselect_all
! 		$self dehilite_io
! 	    }
! 	    if {$@keynav} {set @keynav 0}
! 	    
! 	    #this should be better sorted out in canvas tab_jump
! 	    if {$@keynav_tab_sel == "object"} {set @keynav_tab_sel "wire"} else {set @keynav_tab_sel "object"}
  	}
- 	default {}
-     }
  }
  
--- 3182,3234 ----
  
  def Canvas key {x y key iso shift} {
! 	$self hide_tooltip
! 	if {[$self focus] != ""} {
! 		[$self focus] key $key $shift
  	}
! 	#if {$iso != ""} {scan $iso %c key}
! 	if {$shift} {set motion 10} {set motion 1}
! 	switch -regexp -- $key {
! 		BackSpace|Delete|KP_Delete {$self delete_selection}
! 		Up    {if {[llength $@selection]} {$self selection_move 0 -$motion} else {$self scroll y -$motion}}
! 		Down  {if {[llength $@selection]} {$self selection_move 0 +$motion} else {$self scroll y +$motion}}
! 		Left  {if {[llength $@selection]} {$self selection_move -$motion 0} else {$self scroll x -$motion}}
! 		Right {if {[llength $@selection]} {$self selection_move +$motion 0} else {$self scroll x +$motion}}
! 		Tab   {$self tab_jump}
! 		Return {
! 			if {[llength $@selection] == 1} {
! 				if {[llength $@keynav_iosel] < 2} {
! 					if {$_($@selection:_class) == "ObjectBox"} {$@selection edit; $self dehilite_io}
! 				} else {
! 					set from_obj [lindex $@keynav_iosel 0]
! 					set to_obj   [lindex $@keynav_iosel 1]
! 					set from   [lsearch $@children [lindex $@keynav_iosel 0]]
! 					set inlet  [lindex $_($from_obj:ioselect) 0]
! 					set to     [lsearch $@children [lindex $@keynav_iosel 1]]
! 					set outlet [lindex $_($to_obj:ioselect) 0]
! 					pd .$self connect [list $from $inlet $to $outlet]
! 					$self dehilite_io
! 				}
! 			}
! 		}
! 		Escape {
! 			if {[llength $@selection] > 0 | [llength $@selection_wire] > 0} {
! 				$self deselect_all
! 				$self dehilite_io
! 			}
! 			if {$@keynav} {set @keynav 0}
! 			
! 			#this should be better sorted out in canvas tab_jump
! 			if {$@keynav_tab_sel == "object"} {
! 				set @keynav_tab_sel "wire"
! 			} else {
! 				set @keynav_tab_sel "object"
! 			}
! 
! 			#if {[llength [[$self widget] gettags text]]} {
! 			#	puts "    delete something.........."
! 			#}
! 		}
! 		default {}
  	}
  }
  
***************
*** 3370,3374 ****
  def Wire     to {} {return $@obj2}
  def Wire  inlet {} {return $@port2}
- 
  def View draw_wires {} {foreach wire $_($@canvas:wires) {$wire changed}}
  def Wire move {dx dy} {$self changed}
--- 3431,3434 ----
***************
*** 3429,3433 ****
  	#mset {x1 y1} [l/2 [l+ [lrange $bbox1 0 1] [lrange $bbox1 2 3]]]
  	#mset {x2 y2} [l/2 [l+ [lrange $bbox2 0 1] [lrange $bbox2 2 3]]]
! 	set xys [xys $x1 $y1 $x2 $y2]
  	set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
  	# how to customise the arrow size/shape?
--- 3489,3493 ----
  	#mset {x1 y1} [l/2 [l+ [lrange $bbox1 0 1] [lrange $bbox1 2 3]]]
  	#mset {x2 y2} [l/2 [l+ [lrange $bbox2 0 1] [lrange $bbox2 2 3]]]
! 	set xys [list $x1 $y1 $x2 $y2]
  	set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
  	# how to customise the arrow size/shape?





More information about the Pd-cvs mailing list