[PD-cvs] pd/src desire.tk,1.1.2.330,1.1.2.331
Mathieu Bouchard
matju at users.sourceforge.net
Mon Aug 14 15:42:38 CEST 2006
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)]
More information about the Pd-cvs
mailing list