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

6 Jun 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10798
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
copy/paste now ok, kept getting this bug with duplication, i think its 
because of the pd_upload...
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.219
retrieving revision 1.1.2.220
diff -C2 -d -r1.1.2.219 -r1.1.2.220
*** desire.tk	3 Jun 2006 21:16:48 -0000	1.1.2.219
--- desire.tk	4 Jun 2006 06:17:25 -0000	1.1.2.220
***************
*** 141,145 ****
  }
! def* Manager notice {origin args} {
    global poolset
    if {[info exists poolset($origin)]} {
--- 141,145 ----
  }
! def Manager notice {origin args} {
    global poolset
    if {[info exists poolset($origin)]} {
***************
*** 892,896 ****
  def View noutlets {} {return $@noutlets}
! def* View init {} {
    set @selected? 0
    set @ninlets 1
--- 892,896 ----
  def View noutlets {} {return $@noutlets}
! def View init {} {
    set @selected? 0
    set @ninlets 1
***************
*** 973,978 ****
  # in the future, one View may have several canvases. (??)
  # this would mean that the following proc will have to die.
! def* View canvas  {}  {return $@canvas}
! def* View canvas= {c} {set @canvas $c}
#-----------------------------------------------------------------------------------#
--- 973,978 ----
  # in the future, one View may have several canvases. (??)
  # this would mean that the following proc will have to die.
! def View canvas  {}  {return $@canvas}
! def View canvas= {c} {set @canvas $c}
#-----------------------------------------------------------------------------------#
***************
*** 1124,1128 ****
  def* Canvas init {{width 400} {height 300} {geometry +0+0} {editable 1}} {
      super
!     global pd_opendir pd_tearoff OS cmdline look
      set name .$self
      set c .$self.c
--- 1124,1129 ----
  def* Canvas init {{width 400} {height 300} {geometry +0+0} {editable 1}} {
      super
!     global pd_opendir pd_tearoff OS cmdline look canvas
!     set canvas(current) $self
      set name .$self
      set c .$self.c
***************
*** 1382,1386 ****
  class_new io {ganymeda}
! def* io draw/2 {which n y} {
      global look
      set nplus [expr $n==1 ? 1 : $n-1]
--- 1383,1387 ----
  class_new io {ganymeda}
! def io draw/2 {which n y} {
      global look
      set nplus [expr $n==1 ? 1 : $n-1]
***************
*** 1417,1433 ****
  class_new TextBox {Box}
! def* TextBox draw {} {
      # TEXT = the text label
      # text = the input text field
      # confusing?;)
!     puts "metrics: [font metrics courier]"
      global font look
      mset {x1 y1} [$self xy]
-     puts "x1=$x1 y1=$y1"
- 	puts "text === $@text"
    set l {}
    foreach char [split $@text ""] {lappend l [scan $char %c]}
- 	puts "l == $l"
- #    puts "!!!!edit = $@edit!!!!"
      if {$@edit} {
    set t .$@canvas.c.${self}text
--- 1418,1430 ----
  class_new TextBox {Box}
! def TextBox draw {} {
      # TEXT = the text label
      # text = the input text field
      # confusing?;)
!     # puts "metrics: [font metrics courier]"
      global font look
      mset {x1 y1} [$self xy]
    set l {}
    foreach char [split $@text ""] {lappend l [scan $char %c]}
      if {$@edit} {
    set t .$@canvas.c.${self}text
***************
*** 1443,1447 ****
  def Canvas obj_in_edit= {v} {set @obj_in_edit $v}
! def* TextBox edit {} {
    global look font
    if {$@edit} {return}
--- 1440,1444 ----
  def Canvas obj_in_edit= {v} {set @obj_in_edit $v}
! def TextBox edit {} {
    global look font
    if {$@edit} {return}
***************
*** 1489,1493 ****
  }
! def* TextBox tab {} {
    puts "continue..................."
    if {[winfo exists .completion]} {
--- 1486,1490 ----
  }
! def TextBox tab {} {
    puts "continue..................."
    if {[winfo exists .completion]} {
***************
*** 1498,1502 ****
  }
! def* TextBox key {widget x y key iso shift} {
    after 0 "$self after_key $widget"
    switch -- $key {
--- 1495,1499 ----
  }
! def TextBox key {widget x y key iso shift} {
    after 0 "$self after_key $widget"
    switch -- $key {
***************
*** 1508,1512 ****
  }
! def* TextBox after_key {widget} {
    $widget configure -state normal
    set @text [$widget get 1.0 1.end]
--- 1505,1509 ----
  }
! def TextBox after_key {widget} {
    $widget configure -state normal
    set @text [$widget get 1.0 1.end]
***************
*** 1542,1546 ****
  class_new ObjectBox {TextBox}
! def* ObjectBox init {args} {
    super
    global font look
--- 1539,1543 ----
  class_new ObjectBox {TextBox}
! def ObjectBox init {args} {
    super
    global font look
***************
*** 1560,1564 ****
  }
! def* ObjectBox draw {} {
    $self update_size
    set xs $@xs
--- 1557,1561 ----
  }
! def ObjectBox draw {} {
    $self update_size
    set xs $@xs
***************
*** 1586,1590 ****
  }
! def* ObjectBox unedit {} {
    if {!$@edit} {return}
    set @edit 0
--- 1583,1587 ----
  }
! def ObjectBox unedit {} {
    if {!$@edit} {return}
    set @edit 0
***************
*** 1625,1633 ****
#-----------------------------------------------------------------------------------#
! def* Canvas window_title {title} {wm title .$self $title}
! #def* Canvas add {i obj} {lset @children $i $obj}
! #def* Canvas del {i}     {lset @children $i ""}
! def* Canvas children= {children} {
    # think of the children!!!
    set born [lwithout $children $@children]
--- 1622,1630 ----
#-----------------------------------------------------------------------------------#
! def Canvas window_title {title} {wm title .$self $title}
! #def Canvas add {i obj} {lset @children $i $obj}
! #def Canvas del {i}     {lset @children $i ""}
! def Canvas children= {children} {
    # think of the children!!!
    set born [lwithout $children $@children]
***************
*** 1637,1641 ****
    $x subscribe $self; $x changed; $x canvas= $self	
    } else {
! 	puts "$x not been borned yet...."
    set @unborn [lappend @unborn $x]}
    }
--- 1634,1638 ----
    $x subscribe $self; $x changed; $x canvas= $self	
    } else {
! 	puts "$x not been borned yet............."
    set @unborn [lappend @unborn $x]}
    }
***************
*** 1647,1651 ****
  }
! def* Canvas add {obj} {
    set i [lsearch $@children $obj]
    if {!$i} {lappend @children $obj}
--- 1644,1648 ----
  }
! def Canvas add {obj} {
    set i [lsearch $@children $obj]
    if {!$i} {lappend @children $obj}
***************
*** 1654,1658 ****
  }
! def* Canvas del {obj} {
    set i [lsearch $@children $obj]
    if {$i} {set @children [lreplace $@children $i $i]}
--- 1651,1655 ----
  }
! def Canvas del {obj} {
    set i [lsearch $@children $obj]
    if {$i} {set @children [lreplace $@children $i $i]}
***************
*** 1660,1668 ****
  }
! def* Canvas wires= {wires2} {
! 	global _
    set wires {}
    # look up for wire id
- 	puts "duplicating ????????? $@duplicating"
    foreach x $wires2 {
       set outobj [lindex $x 0]
--- 1657,1664 ----
  }
! def Canvas wires= {wires2} {
! 	global _ canvas
    set wires {}
    # look up for wire id
    foreach x $wires2 {
       set outobj [lindex $x 0]
***************
*** 1688,1698 ****
    set born [lwithout $wires $@wires]
    set born_num [expr [llength $born] - 1]
    set i 0
    foreach x $born {
    $x subscribe $self;$x changed;$x canvas= $self
! 	if {$@duplicating} {
! 	lappend @selection_wire $x; $x selected?= 1
! 	if {$i == $born_num} {set @duplicating 0}
! 	}
    incr i
    }
--- 1684,1710 ----
    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 {
    $x subscribe $self;$x changed;$x canvas= $self
! 		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}
! 		}
! 		if {[info exists canvas(copy)]} {
! 		if {$canvas(copy)} {
! 			lappend @selection_wire $x; $x selected?= 1
! 			if {$i == $born_num} {set canvas(copy) 0}
! 			}
! 		}
    incr i
    }
***************
*** 1705,1709 ****
  }
! def* Canvas wires_new {whoout outno whoin inno} {
    # @wires_pair is a workaround for looking up the wire id with {0 1 1 0} format
    # i moved calling wire_new here instead of where it was (canvas wires=) 
--- 1717,1721 ----
  }
! def Canvas wires_new {whoout outno whoin inno} {
    # @wires_pair is a workaround for looking up the wire id with {0 1 1 0} format
    # i moved calling wire_new here instead of where it was (canvas wires=) 
***************
*** 1765,1770 ****
def Canvas motion {x y mods state} {
!     global font
      global tooltip look
      set c .$self.c
      set x [$c canvasx $x]
--- 1777,1783 ----
def Canvas motion {x y mods state} {
!     global font canvas
      global tooltip look
+     set canvas(current) $self
      set c .$self.c
      set x [$c canvasx $x]
***************
*** 1840,1844 ****
        }
        wire {
-       	puts " over a wire! -> $id"
        }
      }
--- 1853,1856 ----
***************
*** 1862,1866 ****
    set tags [$c gettags $tag] 
    if {[regexp {^([0-9a-f]{6,8})} $tags id]} {
- 	    puts "tags:: $tags"
        return [list "wire" $id]
          }
--- 1874,1877 ----
***************
*** 1934,1938 ****
--- 1945,1952 ----
  def* Canvas duplicate {} {
    global _ canvas
+ 	set canvas(dup_wire_num) 0
    if {$@selection != ""} {
+ 		# store the selected objects in canvas(dup_orig), which later will
+ 		# be linked to the cuplicated object 
    	set canvas(dup_orig) $@selection
    	set dups $@selection
***************
*** 1947,1951 ****
    	set @duplicating 1 
    	pd .$self obj [expr $x1 + 15] [expr $y1 +15] $name
! 		set dup_wires $_($item:wires)
    	}
    
--- 1961,1965 ----
    	set @duplicating 1 
    	pd .$self obj [expr $x1 + 15] [expr $y1 +15] $name
! 		#set dup_wires $_($item:wires)
    	}
    
***************
*** 1957,1963 ****
    global _ canvas 
    puts "!!!!!!!!!!! dup wires for these duplicates::: $@selection !!!!!!!!!!!!"
    puts "!!!!!!!!!!! dup wires ::: $@selection_wire !!!!!!!!!!!!"
    puts "!! $@children !!"
! 	set i 0 
    foreach obj $canvas(dup_orig) {set _($obj:duplicate) [lindex $@selection $i]; incr i}
    foreach wire $@selection_wire {
--- 1971,1980 ----
    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
    foreach obj $canvas(dup_orig) {set _($obj:duplicate) [lindex $@selection $i]; incr i}
    foreach wire $@selection_wire {
***************
*** 1966,1970 ****
    	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)"
--- 1983,1987 ----
    	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)"
***************
*** 1977,1982 ****
    #set @duplicating 0
    set @selection_wire ""
    
! 	
  }
--- 1994,2048 ----
    #set @duplicating 0
    set @selection_wire ""
+ }
+ 
+ def* Canvas copy {} {
+ 	global canvas
+ 	if {$@selection != ""} {
+ 		set canvas(copy_obj) $@selection
+ 		set canvas(copy_wire) $@selection_wire
+ 		puts "objects to copy::: $canvas(copy_obj)"
+ 		puts "wires to copy::: $canvas(copy_wire)"
+ 	}
+ 
+ }
+ 
+ def* Canvas paste {} {
+ 	global canvas _
+ 	set @selection ""
+ 	set canvas(copied_obj) ""
+ 	foreach item $canvas(copy_obj) {
+ 	mset {x1 y1} [$item xy]
+ 	if {$_($item:_class) == "Objectbox"} { 
+ 	set name $_($item:text) } else {
+ 	set name $_($item:class)
+ 	}
+ 	set canvas(copy) 1
+ 	pd .$self obj $x1 $y1 $name
+ 	}
+ }
+ 
+ def* Canvas paste_wires {} {
+ 	global canvas _
    
! 	set i 0
! 	# _($obj:duplicate) sotres the duplicated object so that we know how to duplicate the wires
! 	foreach obj $canvas(copy_obj) {set _($obj:duplicate) [lindex $canvas(copied_obj) $i]; incr i}
! 	foreach wire $canvas(copy_wire) {
! 		set obj1 $_($wire:obj1)
! 		set obj2 $_($wire:obj2)
! 		set obj1_copy $_($obj1:duplicate)
! 		set obj2_copy $_($obj2:duplicate)
! 		#puts "::::: $obj1 :: $obj1_copy | $obj2 :: $obj2_copy :::::"
! 		
! 		#puts "connect [lsearch $@children $obj1_copy] $_($wire:port1) [lsearch $@children $obj2_copy] $_($wire:port2)"
! 		pd .$self connect [lsearch $@children $obj1_copy] $_($wire:port1) [lsearch $@children $obj2_copy] $_($wire:port2)
! 		#$wire selected?= 0
! 	}
! 	#clean up
! 	foreach obj $canvas(copy_obj) {set _($obj:duplicate) 0}
! 	set $canvas(copied_obj) ""
! 	set $canvas(copy_obj) ""
! 	set $canvas(copy_wire) ""
! 
  }
***************
*** 2076,2079 ****
--- 2142,2147 ----
def* Canvas click {x y b f} {
+     global canvas
+     #set canvas(current) $self
      set c .$self.c
      focus $c
***************
*** 2164,2168 ****
        }
        move {
- 	puts "something moved ::: $@selection"
    foreach obj $@selection {
      #this could be wrong....
--- 2232,2235 ----
***************
*** 2374,2378 ****
  class_new Wire {View}
! def* Wire init {canvas from outno to inno} {
      super
      global _
--- 2441,2445 ----
  class_new Wire {View}
! def Wire init {canvas from outno to inno} {
      super
      global _
***************
*** 2396,2400 ****
  }
! def* Wire draw {} {
    global look
    #set thick 2
--- 2463,2467 ----
  }
! def Wire draw {} {
    global look
    #set thick 2
***************
*** 2552,2556 ****
    set class [lindex $d $i]
    switch -- $class {
! 		canvas {set class $class; set canvas(current) $x}
    	obj {set i 4; set class [lindex $d 4]}
    }
--- 2619,2624 ----
    set class [lindex $d $i]
    switch -- $class {
! 		#canvas {set class $class; set canvas(current) $x}
! 		canvas {set class $class}
    	obj {set i 4; set class [lindex $d 4]}
    }
***************
*** 2577,2581 ****
--- 2645,2666 ----
    	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
+ 		}
+ 		}
+ 		
+ 		if {[info exists canvas(copy)]} {
+ 		if {$canvas(copy)} {
+ 		puts "copying stuff................ $x"
+ 		$x selected?= 1
+ 		lappend _($canvas(current):selection) $x
+ 		lappend canvas(copied_obj) $x
+ 		if {[llength $canvas(copy_obj)] == [llength $canvas(copied_obj)]} {$canvas(current) paste_wires}
+ 		}
    	}
    }
***************
*** 2608,2620 ****
    		# when it reachs the last unborn child, its time to draw the wires
    		# the end of duplication
    		set _($canvas(current):unborn) ""
    		if {$_($canvas(current):duplicating)} {
! 			#set _($canvas(current):duplicating) 0
! 			$canvas(current) duplicate_wire
    		} else {
    		puts "time to draw wires ----- $_($canvas(current):unborn_wire)"
    		$canvas(current) wires= $_($canvas(current):unborn_wire)
    		set _($canvas(current):unborn_wire) ""
    		}
    	}
    } 
--- 2693,2710 ----
    		# when it reachs the last unborn child, its time to draw the wires
    		# the end of duplication
+ 			puts "###### number of unborn child [llength $_($canvas(current):unborn)] ######"
+ 			puts "###### they are :: $_($canvas(current):unborn) ######"
+ 			puts "###### but we are now at :: $x ######"
    		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) ""
    		}
+ 			}
    	}
    } 
***************
*** 2622,2625 ****
--- 2712,2716 ----
    # maybe this $x changed should be changed, so that when loading a file, changed won't
    # call the drawing method twice...
+ 	
    $x changed
    
***************
*** 2724,2728 ****
  #class_new BlueBox {Box Labeled}
! def* BlueBox draw {} {
    global look
    super
--- 2815,2819 ----
  #class_new BlueBox {Box Labeled}
! def BlueBox draw {} {
    global look
    super
***************
*** 3042,3046 ****
  class_new Labeled {}
! def* Labeled draw {} {
    mset {x1 y1} [$self xy]
    set lx [expr $x1+$@ldx]
--- 3133,3137 ----
  class_new Labeled {}
! def Labeled draw {} {
    mset {x1 y1} [$self xy]
    set lx [expr $x1+$@ldx]