Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4507
Modified Files: Tag: desiredata desire.tk Log Message: subpatcherize2.0
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.600.2.378 retrieving revision 1.1.2.600.2.379 diff -C2 -d -r1.1.2.600.2.378 -r1.1.2.600.2.379 *** desire.tk 15 Aug 2007 17:36:53 -0000 1.1.2.600.2.378 --- desire.tk 16 Aug 2007 03:06:46 -0000 1.1.2.600.2.379 *************** *** 360,375 ****
#-----------------------------------------------------------------------------------# - #used during subpatcherize - set subpatcherize(edit) 0 - set subpatcherize(paste) 0 - set subpatcherize(incoming) {} - set subpatcherize(incoming_inlet) {} - set subpatcherize(incoming_outlet) {} - set subpatcherize(outgoing) {} - set subpatcherize(outgoing_inlet) {} - set subpatcherize(outgoing_outlet) {} - set subpatcherize(future_sub) "" - set subpatcherize(edit2) "" - #-----------------------------------------------------------------------------------# class_new EventHistory {Observable Thing}
--- 360,363 ---- *************** *** 1788,1792 **** default {error "huh? mess=$mess"} } - if {$::subpatcherize(edit2) == $self} {set ::subpatcherize(edit2) ""; $self edit} }
--- 1776,1779 ---- *************** *** 2875,2883 **** def Canvas havewindow {} {return $@havewindow} def Canvas havewindow= {flag} { - # race condition! - # if {$::subpatcherize(future_sub) != ""} { - # $::subpatcherize(future_sub) subpatcherize_paste - # set ::subpatcherize(future_sub) "" - # } set was [winfo exists .$self] #if {$flag && $was && [$self gop]} {$self redraw} --- 2862,2865 ---- *************** *** 3049,3053 **** move {$self motion_move $oldpos $x $y; return} none {} - subpatcherize {} default {$@action motion $x $y $f $target} } --- 3031,3034 ---- *************** *** 3932,3935 **** --- 3913,3917 ----
def Canvas broken_wires {type k port} { + puts "$self obj hash>>>>> $@objects" set obj [$@objects get $k] set wires [$obj wires2]; set brk_wires {}; set quads {} *************** *** 3942,3977 **** }
! ! #def Canvas new_object_subpatcherize {subpatch} {$subpatch subpatcherize_paste} ! def Canvas new_object_subpatcherize {subpatch} { ! if {![info exists _($subpatch:_class)]} { ! post "%s does not exist yet..." $subpatch ! set ::subpatcherize(future_sub) $subpatch } ! } ! def Canvas new_object_subpatcherize_inletconnect {inlet obj} { ! if {[regexp {^[0-9]{1,8}i} $inlet idx]} {set idx [string trimright $idx i]} ! if {[regexp {i[0-9]{1,8}} $inlet port]} {set port [string trimleft $port i]} ! $self connect [list [$@objects search $obj] 0 $idx $port] ! } ! def Canvas new_object_subpatcherize_outletconnect {outlet obj} { ! if {[regexp {^[0-9]{1,8}o} $outlet idx]} {set idx [string trimright $idx o]} ! if {[regexp {o[0-9]{1,8}} $outlet port]} {set port [string trimleft $port o]} ! $self connect [list $idx $port [$@objects search $obj] 0] }
- #hack.. - def Canvas new_object_subpatcherize_redraw {subpatch} { - $self redraw - $self action= "none" - }
! def Canvas subpatcherize {} { ! error "disabled... try again next month" ! set ::subpatcherize(incoming) {}; set ::subpatcherize(outgoing) {} ! set ::subpatcherize(incoming_inlet) {}; set ::subpatcherize(incoming_outlet) {} ! set ::subpatcherize(outgoing_inlet) {}; set ::subpatcherize(outgoing_outlet) {} ! $self action= "subpatcherize" ! if {![$@objectsel size]} {return} set x 0; set y 0 foreach obj [$@objectsel values] { --- 3924,3945 ---- }
! def Canvas broken_wires2 {type k port canvas} { ! set shash [$canvas objectsel] ! set obj [[$canvas objects] get $k] ! set wires [$obj wires2]; set brk_wires {}; set quads {} ! foreach wire $wires { ! mset {f2 o2 t2 i2} [$wire connects] ! if {$t2==$k && $i2==$port && $type=="i" && ![$shash exists $f2]} { ! lappend brk_wires $wire; lappend quads [$wire connects] ! } ! if {$f2==$k && $o2==$port && $type=="o" && ![$shash exists $t2]} { ! lappend brk_wires $wire; lappend quads [$wire connects] ! } } ! return [list $brk_wires $quads] }
! def Canvas selection_center {} { set x 0; set y 0 foreach obj [$@objectsel values] { *************** *** 3983,4100 **** set x [expr $x / $n] set y [expr $y / $n] ! $self subpatcherize_outside ! $self cut ! $self subpatcherize_make_sub $x $y }
! def Canvas subpatcherize_make_sub {x y} { ! netsend [list .$self "push"] ! netsend [list #N canvas 0 0 450 300 sub 0] [list $self new_object_subpatcherize] ! #netsend [list #N canvas 0 0 450 300 sub 0] ! netsend [list #X restore $x $y pd sub] ! netsend [list .$self "pop"] }
! def Canvas subpatcherize_outside {} { ! foreach x [$@objectsel values] {foreach wire [$x wires2] {$self subpatcherize_outside_wire $x $wire}} ! } ! def Canvas subpatcherize_outside_wire {x wire} { ! set wire_list [$wire report] ! switch [lsearch $wire_list $x] { ! 0 { ! set obj [lindex $wire_list 2] ! if {[$@objectsel search $obj] < 0} { ! set outlet [lindex $wire_list 1] ! set x_idx [$@objectsel search $x] ! set obj_out ${x_idx}o${outlet} ! if {[lsearch $::subpatcherize(outgoing_outlet) $obj_out] < 0} { ! lappend ::subpatcherize(outgoing_outlet) $obj_out ! } ! set inlet [lindex $wire_list 3] ! set outlet [lsearch $::subpatcherize(outgoing_outlet) $obj_out] ! lappend ::subpatcherize(outgoing) [list last $outlet $obj $inlet] ! set obj_in ${obj}i${inlet} ! if {[lsearch $::subpatcherize(outgoing_inlet) $obj_in] < 0} { ! lappend ::subpatcherize(outgoing_inlet) $obj_in ! } ! } ! } ! 2 { ! set obj [lindex $wire_list 0] ! if {[$@objectsel search $obj] < 0} { ! set inlet [lindex $wire_list 3] ! set x_idx [$@objectsel search $x] ! set obj_in ${x_idx}i${inlet} ! if {[lsearch $::subpatcherize(incoming_inlet) $obj_in] < 0} { ! lappend ::subpatcherize(incoming_inlet) $obj_in ! } ! set outlet [lindex $wire_list 1] ! set inlet [lsearch $::subpatcherize(incoming_inlet) $obj_in] ! lappend ::subpatcherize(incoming) [list $obj $outlet last $inlet] ! set obj_out ${obj}o${outlet} ! if {[lsearch $::subpatcherize(incoming_outlet) $obj_out] < 0} { ! lappend ::subpatcherize(incoming_outlet) $obj_out ! } ! } } } - puts "-------------------------------------" - puts " in:::: $::subpatcherize(incoming)" - puts " incoming_outlet:: $::subpatcherize(incoming_outlet) " - puts " incoming_inlet::: $::subpatcherize(incoming_inlet)" - puts "-------------------------------------" - puts " out:::: $::subpatcherize(outgoing)" - puts " outgoing_outlet:: $::subpatcherize(outgoing_outlet) " - puts " outgoing_inlet::: $::subpatcherize(outgoing_inlet)" - puts "-------------------------------------" } ! def Canvas subpatcherize_makeports {} { ! global subpatcherize ! set i 0 ! foreach inlet $::subpatcherize(incoming_inlet) { ! netsend [list #X obj [expr $i*100] 0 inlet] [list $self new_object_subpatcherize_inletconnect $inlet] ! incr i } ! set i 0 ! foreach outlet $::subpatcherize(outgoing_outlet) { ! mset {xcoords ycoords} [$self clipboard_coords 0] ! set y [expr [lindex [lsort -increasing $ycoords] end] + 20] ! netsend [list #X obj [expr $i*100] $y outlet] [list $self new_object_subpatcherize_outletconnect $outlet] ! incr i } ! }
! def Canvas subpatcherize_paste {} { ! set subpatcherize(paste) 1 ! set in 0 ! $self deselect_all ! mset {xcoords ycoords} [$self clipboard_coords 0] ! set x [expr [lindex [lsort -increasing $xcoords] 0] - 50] ! set y [expr [lindex [lsort -increasing $ycoords] 0] - 50] netsend [list .$self "push"] ! foreach mess [pd_mess_split [$::clipboard value]] { ! set type [lindex $mess 1] ! if {$type != "" && $type != "canvas" && $type != "connect"} { ! set x1 [lindex $mess 2] ! set y1 [lindex $mess 3] ! set mess2 [lreplace $mess 2 3 [expr $x1 - $x] [expr $y1 -$y]] ! netsend $mess2 ! } else {netsend $mess} ! } ! $self subpatcherize_makeports ! netsend [list #X pop 0] ! $self subpatcherize_reconnect_outside ! set ::subpatcherize(edit2) $self }
! def Canvas subpatcherize_reconnect_outside {} { ! set canvas [$self canvas] ! foreach wire $::subpatcherize(incoming) { ! mset {from outlet to inlet} $wire ! $canvas connect [list [$@objects search $from] $outlet [$@objects search $self] $inlet] ! } ! foreach wire $::subpatcherize(outgoing) { ! mset {from outlet to inlet} $wire ! $canvas connect [list [$@objects search $self] $inlet [$@objects search $to] $outlet] } } --- 3951,4031 ---- set x [expr $x / $n] set y [expr $y / $n] ! return [list $x $y] }
! # translate the key/idx in $@objects to key/idx in $@objectsel ! def Canvas idx_map {idx} { ! set i 0; set obj [$@objects get $idx] ! foreach sobj [$@objectsel values] {if {$obj == $sobj} {return $i}; incr i} ! return -1 }
! def Canvas subpatcherize_mkio {center iolist offset} { ! mset {x y} $center; set inx 0; set outx 0 ! for {set i 0} {$i < [llength $iolist]} {incr i} { ! mset {type io port} [lindex $iolist $i] ! if {$type == "i"} { ! netsend [list #X obj [expr ($inx+1)*100] 0 inlet] ! netsend [list #X connect $offset 0 $io $port] ! incr inx ! } else { ! netsend [list #X obj [expr ($outx+1)*100] [expr $y*2] outlet] ! netsend [list #X connect $io $port $offset 0] ! incr outx } + incr offset } } ! ! def Canvas subpatcherize {} { ! set center [$self selection_center] ! set rewire_off [llength [$@objectsel values]] ! set ins {}; set outs {} ! foreach obj [$@objectsel values] { ! for {set i 0} {$i < [$obj ninlets]} {incr i} { ! mset {brk_wires brk_quads} [$self broken_wires2 i [$@objects search $obj] $i $self] ! if {[llength $brk_wires]} {foreach wire $brk_quads {lappend broken [concat i $wire ]}} ! } ! for {set o 0} {$o < [$obj noutlets]} {incr o} { ! mset {brk_wires brk_quads} [$self broken_wires2 o [$@objects search $obj] $o $self] ! if {[llength $brk_wires]} {foreach wire $brk_quads {lappend broken [concat o $wire]}} ! } } ! # $broken stores totall number of broken connections, i= need [inlet] o = need [outlet] ! foreach c $broken { ! mset {type f o t i} $c ! if {$type == "i"} {lappend ins [list $t $i]} {lappend outs [list $f $o]} } ! # $inlets/$outlets gives the totall number of inlets/outlets to create ! set ins [lsort -unique $ins]; set outs [lsort -unique $outs] ! # iolist stores in/outlets to be conected inside the subpatch ! foreach in $ins {mset {idx p} $in; lappend iolist [list i [$self idx_map $idx] $p]} ! foreach out $outs {mset {idx p} $out; lappend iolist [list o [$self idx_map $idx] $p]}
! puts "\t \t Cutting..............." ! $self cut ! puts "\t \t Push.................." netsend [list .$self "push"] ! netsend [list #N canvas 0 0 450 300 sub 0] [list $self subpatcherize_id] ! puts "\t \t Push clipboard........" ! foreach mess [pd_mess_split [$::clipboard value]] {netsend $mess} ! #creating in/outlets ! $self subpatcherize_mkio $center $iolist $rewire_off ! netsend [list [concat #X restore $center pd sub]] ! puts "\t \t Pop..................." ! netsend [list .$self "pop"] [list $self subpatcherize_rewire $broken] }
! def Canvas subpatcherize_id {id} {set @subpatcherize_id $id} ! ! def Canvas subpatcherize_rewire {wires bogus} { ! set obj $@subpatcherize_id ! foreach wire $wires { ! mset {type f o t i} $wire ! if {$type == "i"} { ! $self connect [list $f $o [$@objects search $obj] $i] ! } else { ! $self connect [list [$@objects search $obj] $o $t $i] ! } } } *************** *** 6831,6835 **** set z [expr 1/[$@canvas zoom]]; set l 0; set g $@gap for {set i [expr int($v1*$z)]} {$i < $v2*$z} {incr i} { ! if {$l%$g == 0} {set width 1;set dash [list 7 1]} {set width 1;set dash [list 4 4 4 4]} if {![expr $i % int($@size)]} { switch $tag { --- 6762,6766 ---- set z [expr 1/[$@canvas zoom]]; set l 0; set g $@gap for {set i [expr int($v1*$z)]} {$i < $v2*$z} {incr i} { ! if {$l%$g == 0} {set width 1;set dash [list 7 1]} {set width 1;set dash [list 1 4 1 4]} if {![expr $i % int($@size)]} { switch $tag {