[PD-cvs] pd/src desire.tk,1.1.2.219,1.1.2.220
chunlee
chunlee at users.sourceforge.net
Sun Jun 4 08:17:28 CEST 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]
More information about the Pd-cvs
mailing list