[PD-cvs] pd/src desire.tk,1.1.2.204,1.1.2.205
chunlee
chunlee at users.sourceforge.net
Tue May 16 03:18:34 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19357
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
file loading should render correctly now, thought there are still a few
issues that needs to be think about..
wires are now can now be delete both in server and client
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.204
retrieving revision 1.1.2.205
diff -C2 -d -r1.1.2.204 -r1.1.2.205
*** desire.tk 15 May 2006 01:51:11 -0000 1.1.2.204
--- desire.tk 16 May 2006 01:18:32 -0000 1.1.2.205
***************
*** 1585,1598 ****
set outport [lindex $x 1]
set inobj [lindex $x 2]
! set inport [lindex $x 3]
set find [lsearch $@wires_pair $x]
if { $find == -1} {
# new wire!!!
! if {[info exists _($outobj:valid)] & [info exists _($inobj:valid)]} {
lappend @wires_pair [list $outobj $outport $inobj $inport]
set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]]
lappend @wires_pair $new_wire
lappend wires $new_wire
! } else {puts "$outobj or $inobj not been born yet....."; set @unborn_wire [lappend @unborn_wire $x]}
} else {
# wire already exist
--- 1585,1600 ----
set outport [lindex $x 1]
set inobj [lindex $x 2]
! set inport [lindex $x 3]
! set obj1 [lindex $@children $outobj]
! set obj2 [lindex $@children $inobj]
set find [lsearch $@wires_pair $x]
if { $find == -1} {
# new wire!!!
! if {[info exists _($obj1:valid)] & [info exists _($obj2:valid)]} {
lappend @wires_pair [list $outobj $outport $inobj $inport]
set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]]
lappend @wires_pair $new_wire
lappend wires $new_wire
! } else {puts "$obj1 or $obj2 not been born yet....."; set @unborn_wire [lappend @unborn_wire $x]}
} else {
# wire already exist
***************
*** 1601,1605 ****
}
set born [lwithout $wires $@wires]; foreach x $born {$x subscribe $self;$x changed;$x canvas= $self}
! set dead [lwithout $@wires $wires]; foreach x $dead {$x unsubscribe $self; $x erase}
set @wires $wires
$self changed
--- 1603,1608 ----
}
set born [lwithout $wires $@wires]; foreach x $born {$x subscribe $self;$x changed;$x canvas= $self}
! #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
***************
*** 1646,1675 ****
}
! def Canvas delete_wire {} {
global _
! set find [lsearch $@wires_pair $x]
! if { $find != -1} {
! #remove the selected wire from the @wire_pair...
! set @wires_pair [lreplace $@wires_pair $find $find]
! set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]]
! }
!
! # removes the wire from the $_($obj1:wires)
! set obj1 $_($x:obj1)
! set find [lsearch $_($obj1:wires) $x]
! if { $find != -1} {
! set _($obj1:wires) [lreplace $_($obj1:wires) $find $find]
! }
! # removes the wire from the $_($obj2:wires)
! set obj2 $_($x:obj2)
! set find [lsearch $_($obj2:wires) $x]
! if { $find != -1} {
! set _($obj2:wires) [lreplace $_($obj2:wires) $find $find]
! }
!
! # i don't know why wires are taged as 00000000WIRE...
! # not sure why $x erase don't work, look later...
! $c delete ${x}WIRE
}
--- 1649,1679 ----
}
! #this is redundent
! def* Canvas delete_wire {obj1 outport obj2 inport} {
global _
! #set find [lsearch $@wires_pair $x]
! #if { $find != -1} {
! ##remove the selected wire from the @wire_pair...
! #set @wires_pair [lreplace $@wires_pair $find $find]
! #set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]]
! #}
! #
! ## removes the wire from the $_($obj1:wires)
! #set obj1 $_($x:obj1)
! #set find [lsearch $_($obj1:wires) $x]
! #if { $find != -1} {
! # set _($obj1:wires) [lreplace $_($obj1:wires) $find $find]
! #}
! ## removes the wire from the $_($obj2:wires)
! #set obj2 $_($x:obj2)
! #set find [lsearch $_($obj2:wires) $x]
! #if { $find != -1} {
! # set _($obj2:wires) [lreplace $_($obj2:wires) $find $find]
! #}
! #
! ## i don't know why wires are taged as 00000000WIRE...
! ## not sure why $x erase don't work, look later...
! #$c delete ${x}WIRE
}
***************
*** 2133,2140 ****
puts "wires: $@wires_pair"
! foreach x $@selection_wire {
!
set find [lsearch $@wires_pair $x]
if { $find != -1} {
# remove the selected wire from the @wire_pair...
set @wires_pair [lreplace $@wires_pair $find $find]
--- 2137,2144 ----
puts "wires: $@wires_pair"
! foreach x $@selection_wire {
set find [lsearch $@wires_pair $x]
if { $find != -1} {
+ pd .$self disconnect [lindex $@wires_pair [expr $find - 1]]
# remove the selected wire from the @wire_pair...
set @wires_pair [lreplace $@wires_pair $find $find]
***************
*** 2412,2416 ****
set canvas(current) ""
! proc update_object {x d} {
global _ fields classinfo canvas
set d [string trimright $d "\n"]
--- 2416,2420 ----
set canvas(current) ""
! proc update_object {x d ninlets noutlets} {
global _ fields classinfo canvas
set d [string trimright $d "\n"]
***************
*** 2455,2468 ****
incr i
}
#-------------------------------------------------------------
set unborn_child [lsearch $_($canvas(current):unborn) $x]
if {$unborn_child > -1} {
$x subscribe $canvas(current)
$x canvas= $canvas(current)
if {$unborn_child == [expr [llength $_($canvas(current):unborn)] - 1]} {
! puts "on to the last unborn child........................"
}
}
#-------------------------------------------------------------
$x changed
--- 2459,2483 ----
incr i
}
+ # hack to get the file loading working, not sure if its a good solution
#-------------------------------------------------------------
set unborn_child [lsearch $_($canvas(current):unborn) $x]
if {$unborn_child > -1} {
+ puts "subscribing unborn child:: $x"
$x subscribe $canvas(current)
$x canvas= $canvas(current)
+ #calling the ninlets because when its called by the server, its too late...
+ #so the $ninlets and $noutlets are added to the sys_vgui call in pd_upload...
+ $x ninlets= $ninlets
+ $x noutlets= $noutlets
+ $x draw
if {$unborn_child == [expr [llength $_($canvas(current):unborn)] - 1]} {
! # when it reachs the last unborn child, its time to draw the wires
! puts "time to draw wires ----- $_($canvas(current):unborn_wire)"
! $canvas(current) wires= $_($canvas(current):unborn_wire)
}
}
#-------------------------------------------------------------
+ # maybe this $x changed should be changed, so that when loading a file, changed won't
+ # call the drawing method twice...
$x changed
More information about the Pd-cvs
mailing list