pd/src desire.tk,1.1.2.220,1.1.2.221 - Pd-cvs

6 Jun 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6741
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
fixed a duplication bug
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.220
retrieving revision 1.1.2.221
diff -C2 -d -r1.1.2.220 -r1.1.2.221
*** desire.tk	4 Jun 2006 06:17:25 -0000	1.1.2.220
--- desire.tk	4 Jun 2006 23:45:45 -0000	1.1.2.221
***************
*** 1684,1693 ****
    set born [lwithout $wires $@wires]
    set born_num [expr [llength $born] - 1]
- 	
- 	if {$@duplicating && [llength $born] > 0} {
- 	puts "##### wires to dup:: $canvas(dup_wire_num) wires got born:: [expr $born_num + 1] #####"
- 	if {$canvas(dup_wire_num) != [expr $born_num + 1]} {}
- 	}
- 	
    set i 0
    foreach x $born {
--- 1684,1687 ----
***************
*** 1695,1702 ****
    	if {$@duplicating} {
    		lappend @selection_wire $x
! 			puts "appending $x from duplication..........."
    		$x selected?= 1
- 			#if {$i == $born_num} {set @duplicating 0}
- 			puts "### how many wires duped? [llength $@selection_wire] total? $canvas(dup_wire_num)"
    		if {[llength $@selection_wire] == $canvas(dup_wire_num)} {set @duplicating 0}
    	}
--- 1689,1694 ----
    	if {$@duplicating} {
    		lappend @selection_wire $x
! 			#puts "appending $x from duplication..........."
    		$x selected?= 1
    		if {[llength $@selection_wire] == $canvas(dup_wire_num)} {set @duplicating 0}
    	}
***************
*** 1710,1715 ****
    }
    
! 	#set dead [lwithout $@wires $wires]; foreach x $dead {$x unsubscribe $self; $x erase}
! 	set dead [lwithout $@wires $wires]; foreach x $dead {$x unsubscribe $self}
    set @wires $wires
    $self changed
--- 1702,1706 ----
    }
    
! 	set dead [lwithout $@wires $wires]; foreach x $dead {$x unsubscribe $self; $x erase}
    set @wires $wires
    $self changed
***************
*** 1970,1978 ****
  def* Canvas duplicate_wire {} {
    global _ canvas 
- 	puts "!!!!!!!!!!! dup wires for these duplicates::: $@selection !!!!!!!!!!!!"
- 	if {[llength $@selection] != [llength $canvas(dup_orig)]} {error "duplication ([llength $canvas(dup_orig)]) and obj born ([llength $@selection]) don't match.."}
- 	puts "!!!!!!!!!!! dup wires ::: $@selection_wire !!!!!!!!!!!!"
- 	puts "!! $@children !!"
    set i 0
    set canvas(dup_wire_num) [llength $@selection_wire]
    # _($obj:duplicate) sotres the duplicated object so that we know how to duplicate the wires
--- 1961,1966 ----
  def* Canvas duplicate_wire {} {
    global _ canvas 
    set i 0
+ 	set wires {}
    set canvas(dup_wire_num) [llength $@selection_wire]
    # _($obj:duplicate) sotres the duplicated object so that we know how to duplicate the wires
***************
*** 1983,1997 ****
    	set obj1_dup $_($obj1:duplicate)
    	set obj2_dup $_($obj2:duplicate)
! 		puts "$obj1 :: $obj1_dup | $obj2 :: $obj2_dup"
! 		
! 		#puts "connect [lsearch $@children $obj1_dup] $_($wire:port1) [lsearch $@children $obj2_dup] $_($wire:port2)"
    	pd .$self connect [lsearch $@children $obj1_dup] $_($wire:port1) [lsearch $@children $obj2_dup] $_($wire:port2)
    	$wire selected?= 0
    }
    #clean up
    foreach obj $canvas(dup_orig) {set _($obj:duplicate) 0}
    set $canvas(dup_orig) ""
    #set @duplicating 0
! 	set @selection_wire ""
  }
--- 1971,1985 ----
    	set obj1_dup $_($obj1:duplicate)
    	set obj2_dup $_($obj2:duplicate)
! 		#puts "$obj1 :: $obj1_dup | $obj2 :: $obj2_dup"
    	pd .$self connect [lsearch $@children $obj1_dup] $_($wire:port1) [lsearch $@children $obj2_dup] $_($wire:port2)
+ 		lappend wires [list [lsearch $@children $obj1_dup] $_($wire:port1) [lsearch $@children $obj2_dup] $_($wire:port2)] 
    	$wire selected?= 0
    }
+ 	set @selection_wire ""
    #clean up
    foreach obj $canvas(dup_orig) {set _($obj:duplicate) 0}
    set $canvas(dup_orig) ""
    #set @duplicating 0
! 	#set @selection_wire ""
  }
***************
*** 2626,2629 ****
--- 2614,2618 ----
    if {![info exists _($x:_class)]} {
    	# new object
+ 		
    	if {[info exists classinfo($class)]} {
    		set _($x:_class) [lindex $classinfo($class) 0]
***************
*** 2643,2656 ****
    	$x init
    	if {$_($canvas(current):duplicating)} {
! 		puts "duplicating stuff............ $x"
    	$x selected?= 1 
- 		lappend _($canvas(current):children) $x
- 		$x subscribe $canvas(current); $x canvas= $canvas(current)
    	lappend _($canvas(current):selection) $x
! 		puts "duplicated ::: [llength $_($canvas(current):selection)]"
! 		puts "are:: $_($canvas(current):selection)"
    	if {[llength $_($canvas(current):selection)] == [llength $canvas(dup_orig)]} {
    	$canvas(current) duplicate_wire
    	}
    	}
    	
--- 2632,2656 ----
    	$x init
    	if {$_($canvas(current):duplicating)} {
! 		#puts "duplicating stuff............ $x"
    	$x selected?= 1 
    	lappend _($canvas(current):selection) $x
! 		
! 		
! 		set test [lsearch $_($canvas(current):children) $x]
! 		if {$test <0} {
! 		#puts "$_($x:_class)"
! 			puts "oops..... $x is not in children!!!!!!!!!!!!!!!!!!!"
! 			$x subscribe $canvas(current)
! 			$x canvas= $canvas(current)
! 			$x ninlets= $ninlets
! 			$x noutlets= $noutlets
! 			lappend _($canvas(current):children) $x
! 		}
! 		
    	if {[llength $_($canvas(current):selection)] == [llength $canvas(dup_orig)]} {
+ 		#puts "############ dude, all done ##################"
    	$canvas(current) duplicate_wire
    	}
+ 		
    	}
    	
***************
*** 2698,2710 ****
    		set _($canvas(current):unborn) ""
    		
! 			if {$_($canvas(current):duplicating)} {
! 			#$canvas(current) duplicate_wire
! 			} else {
    		if {[info exists _($canvas(current):unborn_wire)]} {
    		puts "time to draw wires ----- $_($canvas(current):unborn_wire)"
    		$canvas(current) wires= $_($canvas(current):unborn_wire)
! 			set _($canvas(current):unborn_wire) ""
! 			}
    		}
    	}
    } 
--- 2698,2709 ----
    		set _($canvas(current):unborn) ""
    		
! 			
    		if {[info exists _($canvas(current):unborn_wire)]} {
    		puts "time to draw wires ----- $_($canvas(current):unborn_wire)"
    		$canvas(current) wires= $_($canvas(current):unborn_wire)
! 			#set _($canvas(current):unborn_wire) ""
! 			unset _($canvas(current):unborn_wire)
    		}
+ 			
    	}
    } 
***************
*** 2712,2718 ****
    # maybe this $x changed should be changed, so that when loading a file, changed won't
    # call the drawing method twice...
- 	
    $x changed
    
  }
--- 2711,2727 ----
    # maybe this $x changed should be changed, so that when loading a file, changed won't
    # call the drawing method twice...
    $x changed
    
+ 	#if {$_($canvas(current):duplicating)} {
+ 	#	if {$_($x:_class) != "Canvas"} {
+ 	#	set test [lsearch $_($canvas(current):children) $x]
+ 	#	if {$test <0} {
+ 	#	puts "$_($x:_class)"
+ 	#	puts "oops..... $x is not in children!!!!!!!!!!!!!!!!!!!"
+ 	#	puts "children are $_($canvas(current):children)"
+ 	#	}
+ 	#	}
+ 	#}
+ 	
  }