Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18798
Modified Files: Tag: desiredata desire.tk Log Message: adapting to the new changes regarding to wire stuff
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.600.2.72 retrieving revision 1.1.2.600.2.73 diff -C2 -d -r1.1.2.600.2.72 -r1.1.2.600.2.73 *** desire.tk 13 Dec 2006 07:23:13 -0000 1.1.2.600.2.72 --- desire.tk 13 Dec 2006 17:16:41 -0000 1.1.2.600.2.73 *************** *** 1211,1215 ****
def View canvas {} {return $@canvas} ! def View canvas= {c} {set @canvas $c}
def View visible {} {if {[info exists @inside_box]} {return $@inside_box} {return -1}} --- 1211,1218 ----
def View canvas {} {return $@canvas} ! def View canvas= {c} { ! set @canvas $c ! $self subscribe $c; $self changed ! }
def View visible {} {if {[info exists @inside_box]} {return $@inside_box} {return -1}} *************** *** 1848,1851 **** --- 1851,1856 ----
def Canvas new_object_callback {obj} {} + def Canvas new_object_select {obj} {$self selection+= $obj} + def Canvas new_wire_select {wire} {$self selection_wire+= $wire} def Canvas new_object_edit {obj} { if {[$obj class] == "NumBox"} {return} *************** *** 2333,2357 **** global paste if {!$@mapped} {return}; set @folder $folder; $self update_title - $self done_update - } - - def Canvas done_update {} { - global paste subpatcherize - if {$self == $paste(state)} {$self done_paste} - if {$self == $subpatcherize(parent) && $subpatcherize(cut)} { - set subpatcherize(cut) 0; set subpatcherize(insert) 1 - set construct "#X obj $subpatcherize(x) $subpatcherize(y) pd sub$subpatcherize(count)" - netsend [list .$self object_insert [expr [llength $@children] - 1] $construct] - return - } - if {$self != $subpatcherize(parent) && $subpatcherize(insert)} { - set subpatcherize(sub) $self - } - if {$self == $subpatcherize(parent) && $subpatcherize(insert)} { - if {$subpatcherize(sub) == "0"} {return} - $subpatcherize(sub) paste - set subpatcherize(insert) 0 - return - } }
--- 2338,2341 ---- *************** *** 2455,2491 ****
# should be only called from the server ! def Canvas wires= {wires2} { ! global clipboard ! set wires {} ! foreach x $wires2 { ! mset {outobj outport inobj inport} $x ! set obj1 [lindex $@children $outobj] ! set obj2 [lindex $@children $inobj] ! set find [lsearch $@wires_pair $x] ! if {$find == -1} {# new wire!!! ! lappend @wires_pair [list $outobj $outport $inobj $inport] ! set new_wire [Wire_new $self $outobj $outport $inobj $inport] ! lappend @wires_pair $new_wire ! lappend wires $new_wire ! } else {# wire already exists ! lappend wires [lindex $@wires_pair [expr $find + 1]] ! } ! } ! set born [lwithout $wires $@wires] ! set born_num [expr [llength $born] - 1] ! foreach x $born { ! $x subscribe $self ! $x changed ! $x canvas= $self ! } set dead [lwithout $@wires $wires] ! foreach x $dead { ! $x delete ! set find [lsearch $@wires_pair $x] ! set @wires_pair [lreplace $@wires_pair [expr $find -1] $find] ! $x unsubscribe $self; $x delete ! } set @wires $wires - foreach x $@wires {$x outside_of_the_box} $self changed } --- 2439,2447 ----
# should be only called from the server ! def Canvas wires= {wires} { ! set new [lwithout $wires $@wires] set dead [lwithout $@wires $wires] ! foreach x [lreverse $dead] {$x unsubscribe $self; $x erase} ;# should use delete instead? set @wires $wires $self changed } *************** *** 2504,2511 **** foreach obj $@selection { foreach wire $_($obj:wires2) { ! set find [lsearch $@wires_pair $wire] ! if {$find != -1} { ! $self disconnect [lindex $@wires_pair [expr $find - 1]] ! } $wire delete } --- 2460,2465 ---- foreach obj $@selection { foreach wire $_($obj:wires2) { ! set find [lsearch $@wires $wire] ! if {$find != -1} {$self disconnect $wire} $wire delete } *************** *** 2513,2520 **** } foreach x $@selection_wire { ! set find [lsearch $@wires_pair $x] ! if {$find != -1} { ! $self disconnect [lindex $@wires_pair [expr $find - 1]] ! } $x delete } --- 2467,2472 ---- } foreach x $@selection_wire { ! set find [lsearch $@wires $x] ! if {$find != -1} {$self disconnect $x} $x delete } *************** *** 2959,2972 **** def Canvas do_paste {offset} { global paste subpatcherize - set @obj_count 0; set @wire_count 0 set in 0 ! #foreach mess [pd_mess_split [$::clipboard value]] { ! # set type [lindex $mess 1] ! # switch $type {connect {} restore {} default {if {$type != ""} {incr paste(count)}}} ! #} mset {vx1 vy1 vx2 vy2} [$self visible_rect] mset {xcoords ycoords} [$self clipboard_coords $offset] set visible [$self paste_visible? $vx1 $vy1 $vx2 $vy2 $offset] - set ref [lsearch $ycoords [lindex [lsort -increasing $ycoords] 0]] #pd .$self push --- 2911,2919 ---- def Canvas do_paste {offset} { global paste subpatcherize set in 0 ! $self deselect_all mset {vx1 vy1 vx2 vy2} [$self visible_rect] mset {xcoords ycoords} [$self clipboard_coords $offset] set visible [$self paste_visible? $vx1 $vy1 $vx2 $vy2 $offset] set ref [lsearch $ycoords [lindex [lsort -increasing $ycoords] 0]] #pd .$self push *************** *** 2981,2985 **** set count [llength $@children] set mess2 [list #X connect [expr $from+$count] $outlet [expr $to+$count] $inlet] ! if {$in} {netsend $mess} else {netsend $mess2; incr @wire_count} } default { --- 2928,2932 ---- set count [llength $@children] set mess2 [list #X connect [expr $from+$count] $outlet [expr $to+$count] $inlet] ! if {$in} {netsend $mess} else {netsend $mess2 [list $self new_wire_select]} } default { *************** *** 2997,3002 **** set mess2 [lreplace $mess 2 3 $x2 $y2] } ! netsend $mess2 [list $self new_object_callback] ! incr @obj_count } } --- 2944,2948 ---- set mess2 [lreplace $mess 2 3 $x2 $y2] } ! netsend $mess2 [list $self new_object_select] } } *************** *** 3006,3017 **** }
- def Canvas done_paste {} { - global paste subpatcherize - $self deselect_all - $self selection= [lrange $@children [expr [llength $@children] - $@obj_count] end] - $self selection_wire= [lrange $@wires [expr [llength $@wires] - $@wire_count] end] - set paste(state) 0 - } - def Canvas cut {} { $@history atomically [list cut] { --- 2952,2955 ---- *************** *** 3084,3089 **** puts "$@wires_pair" set @keynav_tab_sel "wire" ! $self selection_wire-= [lindex $@wires_pair [expr [lsearch $@wires_pair $wire]+1]] ! mset {from outlet to inlet} $wire netsend [list .$self disconnect $from $outlet $to $inlet] $@history add [list $self connect $wire] --- 3022,3028 ---- puts "$@wires_pair" set @keynav_tab_sel "wire" ! #$self selection_wire-= [lindex $@wires_pair [expr [lsearch $@wires_pair $wire]+1]] ! #mset {from outlet to inlet} $wire ! mset {from outlet to inlet} [$wire connects] netsend [list .$self disconnect $from $outlet $to $inlet] $@history add [list $self connect $wire] *************** *** 4186,4202 **** class_new Wire {View}
! def Wire init {canvas from outlet to inlet} { ! super ! set @connects [list $from $outlet $to $inlet] ! set children $_($canvas:children) set @obj1 [lindex $children $from] set @obj2 [lindex $children $to] - set @port1 $outlet - set @port2 $inlet - set @canvas $canvas # associate wires to its connected objects lappend _($@obj1:wires2) $self lappend _($@obj2:wires2) $self ! #$self subscribe $canvas }
--- 4125,4150 ---- class_new Wire {View}
! def Wire canvas= {c} { ! super $c ! mset {from outlet to inlet} $@connects ! set children [$c children] set @obj1 [lindex $children $from] set @obj2 [lindex $children $to] # associate wires to its connected objects lappend _($@obj1:wires2) $self lappend _($@obj2:wires2) $self ! } ! ! def Wire init {mess} { ! super ! $self reinit $mess ! } ! ! def Wire reinit {mess} { ! mset {x msg from outlet to inlet canvas} $mess ! set @connects [list $from $outlet $to $inlet] ! set @port1 $outlet ! set @port2 $inlet ! $self outside_of_the_box }
*************** *** 4424,4428 **** set _class [lindex $classinfo($class) 0] } else { ! set _class ObjectBox } if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess} --- 4372,4380 ---- set _class [lindex $classinfo($class) 0] } else { ! if {[lindex $mess 1] == "connect"} { ! set _class Wire ! } else { ! set _class ObjectBox ! } } if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}