pd/src desire.tk,1.1.2.334,1.1.2.335 - Pd-cvs

14 Aug 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 ----