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