[PD-cvs] pd/src desire.tk,1.1.2.600.2.72,1.1.2.600.2.73
chunlee
chunlee at users.sourceforge.net
Wed Dec 13 18:16:44 CET 2006
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}
More information about the Pd-cvs
mailing list