[PD-cvs] pd/src desire.tk,1.1.2.334,1.1.2.335
Mathieu Bouchard
matju at users.sourceforge.net
Mon Aug 14 17:45:48 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8101
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
new SelRect action class with corrected zoom
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.334
retrieving revision 1.1.2.335
diff -C2 -d -r1.1.2.334 -r1.1.2.335
*** desire.tk 14 Aug 2006 14:33:20 -0000 1.1.2.334
--- desire.tk 14 Aug 2006 15:45:46 -0000 1.1.2.335
***************
*** 1661,1665 ****
foreach o $@selection {$o selected?= 1}
}
-
def Canvas selection+= {objs} {
set @selection [concat [lwithout $@selection $objs] $objs]
--- 1661,1664 ----
***************
*** 1667,1670 ****
--- 1666,1680 ----
}
+ def Canvas selection_wire {} {return $@selection_wire}
+ def Canvas selection_wire= {wires} {
+ foreach o $@selection_wire {$o selected?= 0}
+ set @selection_wire $wires
+ foreach o $@selection_wire {$o selected?= 1}
+ }
+ def Canvas selection_wire+= {wires} {
+ set @selection_wire [concat [lwithout $@selection_wire $objs] $objs]
+ foreach o $wires {$o selected?= 1}
+ }
+
def ObjectBox draw_box {} {
global font
***************
*** 2119,2123 ****
class_new FutureWire {View}
! def* FutureWire init {canvas x y bf target} {
super
set @canvas $canvas
--- 2129,2133 ----
class_new FutureWire {View}
! def FutureWire init {canvas x y bf target} {
super
set @canvas $canvas
***************
*** 2132,2136 ****
$self motion $@x1 $@y1 0 $target
}
! def* FutureWire motion {x y f target} {
set @x2 $x
set @y2 $y
--- 2142,2146 ----
$self motion $@x1 $@y1 0 $target
}
! def FutureWire motion {x y f target} {
set @x2 $x
set @y2 $y
***************
*** 2139,2143 ****
$self draw
}
! def* FutureWire unclick {x y bf target} {
$self motion $x $y $bf $target
if {$@to != ""} {
--- 2149,2153 ----
$self draw
}
! def FutureWire unclick {x y bf target} {
$self motion $x $y $bf $target
if {$@to != ""} {
***************
*** 2152,2156 ****
$self item WIRE line [list $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [look wiredash]
}
! def* FutureWire _delete {} {super}
#!@#$ this method is too long
--- 2162,2206 ----
$self item WIRE line [list $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [look wiredash]
}
!
! class_new SelRect {View}
! def* SelRect init {canvas x y bf target} {
! super
! set @x1 $x
! set @y1 $y
! set @canvas $canvas
! $self motion $x $y 0 $target
! }
! def* SelRect motion {x y f target} {
! set @x2 $x
! set @y2 $y
! $self draw
! }
! def* SelRect unclick {x y bf target} {
! $self motion $x $y 0 $target
! set sel {}
! set c .$@canvas.c
! mset {x1 y1 x2 y2} [lmap * [list $@x1 $@y1 $@x2 $@y2] [$@canvas scale]]
! set sel [$c find overlapping $x1 $y1 $x2 $y2]
! set selrect_index [lsearch $sel [$c find withtag selrect]]
! set sel [lreplace $sel $selrect_index $selrect_index]
! if {[llength $sel]} {
! set objects {}
! set wires {}
! foreach tag $sel {
! if {[regexp {^x([a-f0-9]{6,8})} [$c gettags $tag] id]} {lappend objects $id}
! if {[regexp {^([0-9a-f]{6,8})} [$c gettags $tag] id]} {lappend wires $id}
! }
! set objects [lsort -unique $objects]
! set wires [lsort -unique $wires]
! $@canvas selection+= $objects
! $@canvas selection+= $wires
! }
! set _($@canvas:select_by) "selrect"
! $@canvas end_action
! }
! def* SelRect draw {} {
! $self item RECT line [list $@x1 $@y1 $@x2 $@y1 $@x2 $@y2 $@x1 $@y2 $@x1 $@y1] \
! -fill black -dash {3 3 3 3} -dashoffset 3 -fill [look selrect]
! }
#!@#$ this method is too long
***************
*** 2163,2175 ****
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 {}}
- # if clicked on empty space in edit mode, draw dash sel rect
- if {![llength $id]} {
- $self deselect_all
- $self dehilite_io
- set @action rect
- $c create line $x $y $x $y $x $y $x $y $x $y \
- -tags {selrect1 selrect} -fill black -dash {3 3 3 3} -dashoffset 3 -fill [look selrect]
- return
- }
set in_selection [expr [lsearch $@selection $id]>=0]
--- 2213,2216 ----
***************
*** 2227,2231 ****
}
}
! default {error BORK}
}
--- 2268,2278 ----
}
}
! nothing {
! $self deselect_all
! $self dehilite_io
! set @action [SelRect new $@canvas $x $y $bf $target]
! return
! }
! default {error "BORK: $type"}
}
***************
*** 2260,2306 ****
set bf [list $b $f]
switch $@action {
- rect {
- set @selection {}
- mset {x1 y1 x2 y2} [$c bbox selrect]
- #if selrect is always at the last stack order, then we don't need to do this
- set selrect_order [$c find withtag selrect]
- set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
- set selrect_index [lsearch $selected_elements $selrect_order]
- set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
- if {[llength $selected_elements]} {
- set ids {}
- set wids {}
- foreach tag $selected_elements {
- # to get objects
- if {[regexp {^x([a-f0-9]{6,8})} [$c gettags $tag] id]} {lappend ids $id}
- # to get wires
- if {[regexp {^([0-9a-f]{6,8})} [$c gettags $tag] id]} {lappend wids $id}
- }
- set selected_objs [lsort -unique $ids]
- set selected_wires [lsort -unique $wids]
-
- foreach obj $selected_objs {
- set i [lsearch $@selection $obj]
- if {$i<0} {lappend @selection $obj}
- }
-
- foreach wire $selected_wires {
- set i [lsearch $@selection_wire $wire]
- if {$i<0} {lappend @selection_wire $wire}
- }
-
- # hilite objects
- foreach obj $@selection {$obj selected?= 1}
- if {[llength $@selection] == 1} {
- set @keynav_current $@selection
- } else {
- set @keynav_current [lindex $@selection 0]
- }
- # hilite wire
- foreach wire $@selection_wire {$wire selected?= 1}
- }
- set @select_by "selrect"
- $c delete selrect
- }
edit {
#foreach {type id} [$self identify_target $cx $cy -1 -1 "blah "] {}
--- 2307,2310 ----
***************
*** 4218,4224 ****
set tooltip(visible) 0
set tooltip(text) ""
- set tooltip(on_hide) ""
! def Canvas show_tooltip {x y text {on_hide ""}} {
global tooltip
if {$tooltip(visible) && [string compare $text $tooltip(text)]==0} {return}
--- 4222,4227 ----
set tooltip(visible) 0
set tooltip(text) ""
! def Canvas show_tooltip {x y text} {
global tooltip
if {$tooltip(visible) && [string compare $text $tooltip(text)]==0} {return}
***************
*** 4239,4243 ****
set tooltip(visible) 1
set tooltip(text) $text
- set tooltip(on_hide) $on_hide
}
--- 4242,4245 ----
***************
*** 4247,4251 ****
$c delete tooltip_bg tooltip_fg
set tooltip(visible) 0
- if {$tooltip(on_hide) != ""} {$self $tooltip(on_hide)}
}
--- 4249,4252 ----
More information about the Pd-cvs
mailing list