Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29556
Modified Files: Tag: devel_0_39 desire.tk Log Message: committing broken code in order to avoid more conflicts...
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.330 retrieving revision 1.1.2.331 diff -C2 -d -r1.1.2.330 -r1.1.2.331 *** desire.tk 14 Aug 2006 11:12:49 -0000 1.1.2.330 --- desire.tk 14 Aug 2006 13:42:36 -0000 1.1.2.331 *************** *** 1234,1238 **** $self new_menubar $self new_binds ! set @scale 1.0 ;# must be a float, not int set @action none set @selection {} --- 1234,1238 ---- $self new_menubar $self new_binds ! set @scale 1.5 ;# must be a float, not int set @action none set @selection {} *************** *** 1242,1247 **** set @select_by "" set @bbox {0 0 100 100} - set @wire_from {} - set @wire_to {} set @children {} set @unborn {} --- 1242,1245 ---- *************** *** 1879,1883 **** default {$@action motion $x $y $mods} } ! mset {type id} [$self identify_target $x $y -1 -1 "move "] switch $type { object { --- 1877,1881 ---- default {$@action motion $x $y $mods} } ! mset {type id} [$self identify_target $x $y -1 -1 "move"] switch $type { object { *************** *** 1906,1918 ****
#-----------------------------------------------------------------------------------# ! def Canvas identify_target {x y b f label} { set c .$self.c ! set x [expr $x*$@scale] ! set y [expr $y*$@scale] ! set stack [lreverse [$c find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]]] foreach tag $stack { set tags [$c gettags $tag] if {[regexp {^x([a-f0-9]{6,8})} $tags id]} { if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown} return [list "object" $id] } --- 1904,1927 ----
#-----------------------------------------------------------------------------------# ! # returns one of those five things: ! # object $id : the body of an object ! # inlet $id $inlet : an inlet of an object ! # outlet $id $outlet : an outlet of an object ! # wire $id : a wire ! # nothing : nothing ! def Canvas identify_target2 {x y b f label} { set c .$self.c ! set cx [expr $x*$@scale] ! set cy [expr $y*$@scale] ! set stack [lreverse [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]] foreach tag $stack { set tags [$c gettags $tag] if {[regexp {^x([a-f0-9]{6,8})} $tags id]} { if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown} + mset {x1 y1 x2 y2} [$id bbox] + set outs [$id noutlets] + set ins [$id ninlets] + if {$y>=$y2-6 && $outs} {return [list "outlet" $id [expr int(($x-$x1)*$outs/($x2-$x1))]]} + if {$y< $y1+2 && $ins} {return [list "inlet" $id [expr int(($x-$x1)* $ins/($x2-$x1))]]} return [list "object" $id] } *************** *** 1925,1928 **** --- 1934,1942 ---- }
+ def Canvas identify_target {x y b f label} { + set r [$self identify_target2 $x $y $b $f $label] + puts "[identify_target $x $y $b $f $label] returns: $r" + return $r + }
#-----------------------------------------------------------------------------------# *************** *** 1956,1961 **** def Canvas statusbar_draw {x y} {$@statusbar draw $x $y} def Canvas action {} {return $@action} ! def Canvas wire_from {} {return $@wire_from} ! def Canvas wire_to {} {return $@wire_to} def Canvas scale {} {return $@scale}
--- 1970,1977 ---- def Canvas statusbar_draw {x y} {$@statusbar draw $x $y} def Canvas action {} {return $@action} ! #def Canvas wire_from {} {return $@wire_from} ! #def Canvas wire_to {} {return $@wire_to} ! def Canvas wire_from {} {return somewhere.} ! def Canvas wire_to {} {return someplace.} def Canvas scale {} {return $@scale}
*************** *** 2100,2133 **** }
class_new FutureWire {View} ! def* FutureWire init {canvas x1 y1} { super - set @x1 $x1 - set @y1 $y1 set @canvas $canvas ! set @wire_from {} ! set @wire_to {} ! $self motion $x1 $y1 0 } ! def* FutureWire motion {x2 y2 mods} {set @x2 $x2; set @y2 $y2; $self draw} ! def* FutureWire unclick {x2 y2 b f} { ! $self motion $x2 $y2 $f ! post "UNCLICK should happen now" ! mset {type id} [$@canvas identify_target $x2 $y2 -1 -1 "unclick"] ! if {$type != "wire"} { ! mset {obj_x1 obj_y1 obj_x2 obj_y2} [$id bbox] ! set ins 0; set ins [$id ninlets] ! if {$y2<$obj_y1+6 && $ins} { ! set in [expr int(($x2-$obj_x1)*$ins/($obj_x2-$obj_x1))] ! set @wire_to [list $id $in] ! mset {from outlet} $@wire_from ! mset {to inlet} $@wire_to ! $@canvas connect [list \ ! [lsearch $_($@canvas:children) $from] $outlet \ ! [lsearch $_($@canvas:children) $to] $inlet] ! } } ! $self _delete ! } def FutureWire draw {} { --- 2116,2161 ---- }
+ def Canvas end_action {} { + $@action _delete + set @action "none" + } + class_new FutureWire {View} ! def* FutureWire init {canvas x y bf target} { super set @canvas $canvas ! set @from $from ! set @outlet $outlet ! set @to "" ! set @inlet "" ! mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${from}o${outlet}] [$@canvas scale]] ! set @x1 [expr ($x1+$x2)/2] ! set @y1 [expr ($y1+$y2)/2] ! $self motion $@x1 $@y1 0 } ! def* FutureWire motion {x y f target} { ! set @x2 $x ! set @y2 $y ! mset {@to @inlet} [$@canvas identify_target $x $y -1 -1 "unclick"] ! $self draw ! } ! def* FutureWire unclick {x y b f} { ! $self motion $x $y $f ! if {$@to != ""} { ! post "WILL CONNECT" ! mset {x1 y1 x2 y2} [$id bbox] ! set ins 0; set ins [$id ninlets] ! if {$y<$y1+6 && $ins} { ! set in [expr int(($x-$x1)*$ins/($x2-$x1))] ! set @wire_to [list $id $in] ! set children [$@canvas children] ! $@canvas connect [list \ ! [lsearch $children $@from] $@outlet \ ! [lsearch $children $@to ] $@inlet] ! } ! } else { ! post "WILL *NOT* CONNECT" } ! if {!$f} {$@canvas end_action} } def FutureWire draw {} { *************** *** 2140,2144 **** def* Canvas clickedit {x y b f} { set c .[$self canvas].c ! mset {type id} [$self identify_target $x $y $b $f "click"] if {$f&8} {$self popup $id [winfo pointerx $c] [winfo pointery $c]; return} if {[llength $@obj_in_edit]} {$@obj_in_edit unedit; set @obj_in_edit {}} --- 2168,2173 ---- def* Canvas clickedit {x y b f} { set c .[$self canvas].c ! set target [$self identify_target $x $y $b $f "click"] ! mset {type id detail} $target if {$f&8} {$self popup $id [winfo pointerx $c] [winfo pointery $c]; return} if {[llength $@obj_in_edit]} {$@obj_in_edit unedit; set @obj_in_edit {}} *************** *** 2155,2177 **** switch $type { ! object { ! # handles the dash wire drawing ! mset {x1 y1 x2 y2} [$id bbox] ! set outs 0; set outs [$id noutlets] ! set ins 0; set ins [$id ninlets] ! if {$y>=$y2-6 && $outs} { ! set out [expr int(($x-$x1)*$outs/($x2-$x1))] ! mset {x1 y1 x2 y2} [$c bbox ${id}o${out}] ! set @action [FutureWire new $self [expr ($x1+$x2)/2] [expr ($y1+$y2)/2]] ! set _($@action:wire_from) [list $id $out] ! set @wire_from [list $id $out] ! #click on a outlet with shift ! if {$f == 1 && ![llength $@shift_wires]} {set @shift_wires $@wire_from} return ! } else { ! if {$y<$y1+2 && $ins} { ! switch $f { ! 1 { ! #click on a inlet with shift mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"] if {$id != ""} { --- 2184,2198 ---- switch $type { ! object {# handles the dash wire drawing ! mset {x1 y1 x2 y2} [$id bbox] ! set outs 0; set outs [$id noutlets] ! set ins 0; set ins [$id ninlets] ! if {$y>=$y2-6 && $outs} { # click on outlet ! set out [expr int(($x-$x1)*$outs/($x2-$x1))] ! set @action [FutureWire new $self $x $y $target] return ! } else { ! if {$y<$y1+2 && $ins} { # click on inlet ! if {$f} {#click on an inlet with shift mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"] if {$id != ""} { *************** *** 2186,2192 **** } return ! } ! } ! default {puts "do nothing....."} } } else { --- 2207,2211 ---- } return ! } } } else { *************** *** 2210,2217 **** $id selected?= 1 } ! 1 { ! puts " click on a wire with shift" ! #clcik on a wire with shift ! #if clcik on the one already selected wire, reconnect it if {[llength $@selection_wire] == 1 && $@selection_wire == $id} { set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]] --- 2229,2234 ---- $id selected?= 1 } ! 1 {#click on a wire with shift ! #if click on the one already selected wire, reconnect it if {[llength $@selection_wire] == 1 && $@selection_wire == $id} { set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]] *************** *** 2222,2231 **** set obj1 [lindex $@children [lindex $wire 0]] set outlet [lindex $wire 1] - mset {x1 y1 x2 y2} [$obj1 bbox] mset {x1 y1 x2 y2} [$c bbox ${obj1}o${outlet}] ! $c create line [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] $x $y -dash {4 4 4 4} -tags lnew -fill [look wiredash] ! set @wire_from [list $obj1 $outlet] ! if {![llength $@shift_wires]} {set @shift_wires $@wire_from; puts "store::::: $@shift_wires"} ! set @action wire } else { #else selecting mltiple wires --- 2239,2244 ---- set obj1 [lindex $@children [lindex $wire 0]] set outlet [lindex $wire 1] mset {x1 y1 x2 y2} [$c bbox ${obj1}o${outlet}] ! set @action [FutureWire new $x $y $obj1 $outlet] } else { #else selecting mltiple wires *************** *** 2233,2237 **** } } ! 2 { set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]] $id delete --- 2246,2250 ---- } } ! 2 {# ctrl-click on wire? set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]] $id delete *************** *** 2245,2249 **** $c create line [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] $x $y -dash {4 4 4 4} -tags lnew -fill [look wiredash] set @wire_from [list $obj1 $outlet] - if {![llength $@shift_wires]} {set @shift_wires $@wire_from; puts "store::::: $@shift_wires"} set @action wire } --- 2258,2261 ---- *************** *** 2328,2352 **** $c delete selrect } - wire { - #mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"] - # if making wire without shift key (delete the dash line) - set x1 $x - set y1 $y - mset {type id} [$@canvas identify_target $x $y -1 -1 "unclick"] - if {$id != ""} { - mset {x1 y1 x2 y2} [$id bbox] - set ins 0; set ins [$id ninlets] - if {$y<$y1+6 && $ins} { - set in [expr int(($x-$x1)*$ins/($x2-$x1))] - set @wire_to [list $id $in] - mset {from outlet} $@wire_from - mset {to inlet} $@wire_to - $self connect [list \ - [lsearch $@children $from] $outlet \ - [lsearch $@children $to] $inlet] - } - } - if {!$f} {$c delete lnew} - } edit { #foreach {type id} [$self identify_target $cx $cy -1 -1 "blah "] {} --- 2340,2343 ---- *************** *** 2703,2707 **** for {set n 0} {$n<$ports} {incr n} { set tag $self$type$n ! set area [.$@canvas.c bbox $self$type$n] set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ] set dist [expr abs($x - $center)] --- 2694,2698 ---- for {set n 0} {$n<$ports} {incr n} { set tag $self$type$n ! set area [lmap / [.$@canvas.c bbox $self$type$n] [$@canvas scale]] set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ] set dist [expr abs($x - $center)]
-
Mathieu Bouchard