Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5232
Modified Files: Tag: devel_0_39 desire.tk Log Message: refixed wire creation
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.331 retrieving revision 1.1.2.332 diff -C2 -d -r1.1.2.331 -r1.1.2.332 *** desire.tk 14 Aug 2006 13:42:36 -0000 1.1.2.331 --- desire.tk 14 Aug 2006 14:04:56 -0000 1.1.2.332 *************** *** 1841,1844 **** --- 1841,1847 ---- set canvas(current) $self set c .$self.c + set b 0 + set f $mods + set bf [list $b $f] set x [expr [$c canvasx $x]/$@scale] set y [expr [$c canvasy $y]/$@scale] *************** *** 1875,1879 **** none {} #default {error "unknown action '$@action'"} ! default {$@action motion $x $y $mods} } mset {type id} [$self identify_target $x $y -1 -1 "move"] --- 1878,1885 ---- none {} #default {error "unknown action '$@action'"} ! default { ! set target [$self identify_target $x $y $b $f "motion"] ! $@action motion $x $y $mods $target ! } } mset {type id} [$self identify_target $x $y -1 -1 "move"] *************** *** 1936,1940 **** 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 } --- 1942,1946 ---- 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 } *************** *** 2121,2128 **** --- 2127,2139 ---- }
+ proc shift? {bf} {mset {b f} $bf; return [expr $f&1]} + proc ctrl? {bf} {mset {b f} $bf; return [expr $f&2]} + proc alt? {bf} {mset {b f} $bf; return [expr $f&4]} + class_new FutureWire {View} def* FutureWire init {canvas x y bf target} { super set @canvas $canvas + mset {type from outlet} $target set @from $from set @outlet $outlet *************** *** 2132,2161 **** 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 {} { --- 2143,2164 ---- set @x1 [expr ($x1+$x2)/2] set @y1 [expr ($y1+$y2)/2] ! $self motion $@x1 $@y1 0 $target } def* FutureWire motion {x y f target} { set @x2 $x set @y2 $y ! #mset {type @to @inlet} $target ;# fix objective.tcl please... ! mset [list type @to @inlet] $target $self draw } ! def* FutureWire unclick {x y bf target} { ! $self motion $x $y $bf $target if {$@to != ""} { ! set children [$@canvas children] ! $@canvas connect [list \ ! [lsearch $children $@from] $@outlet \ ! [lsearch $children $@to ] $@inlet] } ! if {![shift? $bf]} {$@canvas end_action} } def FutureWire draw {} { *************** *** 2168,2171 **** --- 2171,2175 ---- def* Canvas clickedit {x y b f} { set c .[$self canvas].c + set bf [list $b $f] ;# i want to merge b and f together but it's not going to be merged like this set target [$self identify_target $x $y $b $f "click"] mset {type id detail} $target *************** *** 2184,2187 **** --- 2188,2192 ---- switch $type { + outlet {set @action [FutureWire new $self $x $y $bf $target]; return} object {# handles the dash wire drawing mset {x1 y1 x2 y2} [$id bbox] *************** *** 2189,2195 **** 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 --- 2194,2197 ---- *************** *** 2296,2299 **** --- 2298,2302 ---- global look set c .$self.c + set bf [list $b $f] switch $@action { rect { *************** *** 2359,2363 **** none {} #default {error "unknown action '$@action'"} ! default {$@action unclick $x $y $b $f} } } --- 2362,2369 ---- none {} #default {error "unknown action '$@action'"} ! default { ! set target [$self identify_target $x $y $b $f "unclick"] ! $@action unclick $x $y $bf $target ! } } }