Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15683
Modified Files: Tag: desiredata desire.tk Log Message: added expand_port
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.600.2.376 retrieving revision 1.1.2.600.2.377 diff -C2 -d -r1.1.2.600.2.376 -r1.1.2.600.2.377 *** desire.tk 15 Aug 2007 17:27:06 -0000 1.1.2.600.2.376 --- desire.tk 15 Aug 2007 17:31:51 -0000 1.1.2.600.2.377 *************** *** 2111,2114 **** --- 2111,2124 ---- }
+ def Canvas xy_snap {x y} { + if {[$self look snap_grid]} { + set grid [$self look grid_size] + set x [expr floor($x/$grid)*$grid] + set y [expr floor($y/$grid)*$grid] + } + return [list $x $y] + + } + def Canvas new_object {sel args} { $self editmode= 1 *************** *** 2128,2132 **** --- 2138,2144 ---- netsend [concat [list .$self $sel $x $y] $args] $goto } + def Canvas new_wire_callback {wire} {} + def Canvas new_object_callback {obj} { $self add_to_obj_history $obj *************** *** 2135,2138 **** --- 2147,2151 ---- if {$@keynav} {$self update_Active $obj} } + def Canvas new_object_copyselect {obj} { $self selection+= $obj *************** *** 2140,2144 **** --- 2153,2159 ---- #$self click_on_object $obj 0 } + def Canvas new_wire_select {wire} {$self selection_wire+= $wire} + def Canvas new_object_edit {obj} { if {[$obj class] == "NumBox"} {return} *************** *** 3878,3881 **** --- 3893,3946 ---- }
+ def Canvas reconnect_brkwires {type brk_quads obj} { + set k [$@objects search $obj] + foreach quad $brk_quads { + mset {from outlet to inlet} $quad + set orig_outlet $outlet; set orig_inlet $inlet + switch $type { + i {set orig_obj $to; set to $k; set inlet 0} + o {set orig_obj $from; set from $k; set outlet 0} + } + netsend [list .$self connect $from $outlet $to $inlet] + } + if {$type == "i"} { + netsend [list .$self connect $k 0 $orig_obj $orig_inlet] + } else { + netsend [list .$self connect $orig_obj $orig_outlet $k 0] + } + $self new_object_callback $obj + + } + + def Canvas expand_port {type k port} { + set obj [$@objects get $k] + mset {bx1 by1 bx2 by2} [$obj io_bbox $type $port] + mset {ox1 oy1 ox2 oy2} [$obj bbox] + mset ys [expr $oy2-$oy1] + mset {brk_wires brk_quads} [$self broken_wires $type $k $port] + switch $type { + i {mset {nx ny} [$self xy_snap $bx1 [expr $by1-25]]} + o {mset {nx ny} [$self xy_snap $bx1 [expr $by1+$ys+25]]} + } + foreach quad $brk_quads {$self disconnect $quad} + set reply [list $self reconnect_brkwires $type $brk_quads] + netsend [concat [list .$self obj $nx $ny] t a] $reply + + } + + def Canvas outlet_expand {k outlet} {set reconnect [$self broken_wires o $k $inlet]} + + def Canvas broken_wires {type k port} { + set obj [$@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"} {lappend brk_wires $wire; lappend quads [$wire connects]} + if {$f2==$k && $o2==$port && $type=="o"} {lappend brk_wires $wire; lappend quads [$wire connects]} + } + return [list $brk_wires $quads] + } + + #def Canvas new_object_subpatcherize {subpatch} {$subpatch subpatcherize_paste} def Canvas new_object_subpatcherize {subpatch} {