pd/src desire.tk,1.1.2.55,1.1.2.56 - Pd-cvs

14 Sep 2005

      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4733
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
stuff'n'stuff
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.55
retrieving revision 1.1.2.56
diff -C2 -d -r1.1.2.55 -r1.1.2.56
*** desire.tk	14 Sep 2005 09:49:17 -0000	1.1.2.55
--- desire.tk	14 Sep 2005 10:09:48 -0000	1.1.2.56
***************
*** 728,736 ****
  set current_x 0
  set current_y 0
- set tooltip(mx) -1000
- set tooltip(my) -1000
- set tooltip(canvas) foo
- set tooltip(visible) 0
- set tooltip(text) ""
  set dehighlight {}
  set wire_from {}
--- 728,731 ----
***************
*** 882,886 ****
  #-----------------------------------------------------------------------------------#
! proc pdtk_canvas_new {name width height geometry editable} {
    global _
    set self [c2self $name]
--- 877,881 ----
  #-----------------------------------------------------------------------------------#
! proc* pdtk_canvas_new {name width height geometry editable} {
    global _
    set self [c2self $name]
***************
*** 1371,1375 ****
      if {$tooltip(visible)} {
    if {[expr pow($tooltip(mx)-$cx,2) + pow($tooltip(my)-$cy,2) > 100]} {
! 	    hide_canvas_tooltip $tooltip(canvas)
    }
      }
--- 1366,1370 ----
      if {$tooltip(visible)} {
    if {[expr pow($tooltip(mx)-$cx,2) + pow($tooltip(my)-$cy,2) > 100]} {
! 	    $tooltip(canvas) hide_tooltip
    }
      }
***************
*** 1531,1542 ****
  def statusbar update {x y} {
      global _ cmdline
!     set canvas .x$self.c
      set bar .x$self.stat
!     set cx [$canvas canvasx $x]
!     set cy [$canvas canvasy $y]
      $bar.pos configure -text "($cx,$cy)"
!     set tags [$canvas gettags [lindex [$canvas find overlapping \
    [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]] end]]
!     foreach {type id} [identify_target $canvas $cx $cy -1 -1 "click"] {}
      switch $type {
        object {
--- 1526,1537 ----
  def statusbar update {x y} {
      global _ cmdline
!     set c .x$self.c
      set bar .x$self.stat
!     set cx [$c canvasx $x]
!     set cy [$c canvasy $y]
      $bar.pos configure -text "($cx,$cy)"
!     set tags [$c gettags [lindex [$c find overlapping \
    [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]] end]]
!     foreach {type id} [identify_target $self $cx $cy -1 -1 "click"] {}
      switch $type {
        object {
***************
*** 1560,1573 ****
def canvas click {x y b f} {
!     global _ wire_from rightclick_object OS select_area mouse font look
!     puts "canvas_click2::: $self $x $y $b $f"
!     set canvas .x$self.c
!     set cx [$canvas canvasx $x]
!     set cy [$canvas canvasy $y]
      set edit 0; switch $@mode { edit { set edit 1 } }
      set select_area(x1) $x
      set select_area(y1) $y
      set mouse(b1down) 1
!     foreach {type id} [identify_target $canvas $cx $cy $b $f "click"] {}
      switch $type {
        object {
--- 1555,1567 ----
def canvas click {x y b f} {
!     global wire_from rightclick_object OS select_area mouse font look
!     set c .x$self.c
!     set cx [$c canvasx $x]
!     set cy [$c canvasy $y]
      set edit 0; switch $@mode { edit { set edit 1 } }
      set select_area(x1) $x
      set select_area(y1) $y
      set mouse(b1down) 1
!     foreach {type id} [identify_target $self $cx $cy $b $f "click"] {}
      switch $type {
        object {
***************
*** 1579,1589 ****
    	if {$run} {
    		#puts "click click click"
! 			if {$_($id:class) == "bang"} {bang_bang $id $canvas}
! 			event $id clickevent     $canvas $cx $cy $b $f} {
! 			event $id clickeditevent $canvas $cx $cy $b $f
    	}
    }
! 	if {!($f&8) && $edit && [llength [$canvas bbox ${id}BASE]]} {
! 	    foreach {x1 y1 x2 y2} [$canvas bbox ${id}BASE] {}
        if {abs($y2-3-$cy)<=3} {
    	set outs 0
--- 1573,1583 ----
    	if {$run} {
    		#puts "click click click"
! 			if {$_($id:class) == "bang"} {bang_bang $id $c}
! 			event $id clickevent     $c $cx $cy $b $f} {
! 			event $id clickeditevent $c $cx $cy $b $f
    	}
    }
! 	if {!($f&8) && $edit && [llength [$c bbox ${id}BASE]]} {
! 	    foreach {x1 y1 x2 y2} [$c bbox ${id}BASE] {}
        if {abs($y2-3-$cy)<=3} {
    	set outs 0
***************
*** 1591,1604 ****
    	if {$outs} {
    		set out [expr int(($cx-$x1)*$outs/($x2-$x1))]
! 			foreach {ox1 oy1 ox2 oy2} [$canvas bbox ${id}o${out}] {}
! 			wire_draw lnew $canvas 1 $cx $cy $cx $cy
! 			$canvas itemconfigure lnew -dash {4 4 4 4}
    		set wire_from [list $id $out]
    		return
    	}
        }
- 	    # selection
        set already [expr [lsearch $@selection $id]>=0]
- 	    #mine begins --chun
        #if selection only contains one object and has already been selected,
        #allow it to turn into edit mode.
--- 1585,1596 ----
    	if {$outs} {
    		set out [expr int(($cx-$x1)*$outs/($x2-$x1))]
! 			foreach {ox1 oy1 ox2 oy2} [$c bbox ${id}o${out}] {}
! 			wire_draw lnew $c 1 $cx $cy $cx $cy
! 			$c itemconfigure lnew -dash {4 4 4 4}
    		set wire_from [list $id $out]
    		return
    	}
        }
        set already [expr [lsearch $@selection $id]>=0]
        #if selection only contains one object and has already been selected,
        #allow it to turn into edit mode.
***************
*** 1608,1624 ****
        	}
        }
- 	    #mine ends --chun
        if {($f&1) && !$already} {
            pd "$self select-object x$id ;"
- 	 	#puts "___shift click___"   
        } elseif {!$already} {
- 		#pd "$self deselect-all ; $self select-object x$id ;"
- 		#puts "___select this object --> $id"
- 	# my click select object code begins --chun
    	#switch $_($id:class) {
    	    #bang {
    		#puts "clicked on bang :: editable = $edit"

! 			#bang_bang $id $canvas

    	    #}
--- 1600,1611 ----
        	}
        }
        if {($f&1) && !$already} {
            pd "$self select-object x$id ;"
        } elseif {!$already} {
    	#switch $_($id:class) {
    	    #bang {
    		#puts "clicked on bang :: editable = $edit"

! 			#bang_bang $id $c

    	    #}
***************
*** 1630,1642 ****
    			set old_obj [lindex $@selection 0]
    			if {$@select_by == "click"} {
! 					objectbox_complete $old_obj $canvas
    			}
    			set @obj_in_edit 0
    		}
- 			#de-hilight
    		if {[llength $@selection] > 0} {
- 				#puts "dehightlight all!!!!!"
    			foreach obj $@selection {
! 					$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
    			}
    			#set @selection {}
--- 1617,1627 ----
    			set old_obj [lindex $@selection 0]
    			if {$@select_by == "click"} {
! 					objectbox_complete $old_obj $c
    			}
    			set @obj_in_edit 0
    		}
    		if {[llength $@selection] > 0} {
    			foreach obj $@selection {
! 					$c itemconfigure ${obj}BASE -outline $look(objectframe3)
    			}
    			#set @selection {}
***************
*** 1644,1657 ****
    		set @selection {}
    		set @selection [linsert $@selection 0 $id]
- 			#puts "@selection --> $@selection"
    		foreach obj $@selection {
! 				#puts "${obj}BASE :: $canvas"
! 				$canvas itemconfigure ${obj}BASE -outline $look(objectframe4)
    		}
    		set @select_by "click"
    	    #}    		
    	#}
- 		# my click select object code ends
- 		
        }
        set @action move
--- 1629,1638 ----
    		set @selection {}
    		set @selection [linsert $@selection 0 $id]
    		foreach obj $@selection {
! 				$c itemconfigure ${obj}BASE -outline $look(objectframe4)
    		}
    		set @select_by "click"
    	    #}    		
    	#}
        }
        set @action move
***************
*** 1662,1667 ****
        #puts "RIGHTCLICK WIRE"
    }
- 	# my wire click select  --chun
- 	#pd "[canvastosym $canvas] click-on-wire $id $cx $cy $b $f;"
    puts "click on wire"
    #$canvas create line $xys -tags $self -width $thick \
--- 1643,1646 ----
***************
*** 1678,1682 ****
    	if {[info exists @obj_in_edit]} {
    		if {$@obj_in_edit > 0} {
! 				objectbox_complete [lindex $@selection 0] $canvas
    			set @obj_in_edit 0
    		}
--- 1657,1661 ----
    	if {[info exists @obj_in_edit]} {
    		if {$@obj_in_edit > 0} {
! 				[lindex $@selection 0] complete $self
    			set @obj_in_edit 0
    		}
***************
*** 1684,1688 ****
    	if {[llength $@selection] > 0} {
    		foreach obj $@selection {
! 				$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
    		}
    		set @selection {}
--- 1663,1667 ----
    	if {[llength $@selection] > 0} {
    		foreach obj $@selection {
! 				$c itemconfigure ${obj}BASE -outline $look(objectframe3)
    		}
    		set @selection {}
***************
*** 1690,1702 ****
    	if {[llength $@selection_wire] > 0} {
    		foreach wire $@selection_wire {
! 				$canvas itemconfigure $wire -fill $look(wirefg)
    		}
    		set @selection_wire {}
    	}
! 		focus $canvas
    	# my object edit mode code ends
    	set @action rect
! 		$canvas create line $cx $cy $cx $cy $cx $cy $cx $cy $cx $cy -tags selrect
! 		switch $OS { osx {} default { $canvas itemconfigure selrect -dash {3 3 3 3}}}
    }
        }
--- 1669,1681 ----
    	if {[llength $@selection_wire] > 0} {
    		foreach wire $@selection_wire {
! 				$c itemconfigure $wire -fill $look(wirefg)
    		}
    		set @selection_wire {}
    	}
! 		focus $c
    	# my object edit mode code ends
    	set @action rect
! 		$c create line $cx $cy $cx $cy $cx $cy $cx $cy $cx $cy -tags selrect
! 		switch $OS { osx {} default { $c itemconfigure selrect -dash {3 3 3 3}}}
    }
        }
***************
*** 1713,1720 ****
  def canvas mouseup {x y b} {
      global canvas_mouseup wire_from wire_to _ font look offset_wire
!     set canvas .x$self.c
!     set name $canvas
!     set cx [$name canvasx $x]
!     set cy [$name canvasy $y]
      if {[llength $wire_from]} {
          if {[llength $wire_to]} {
--- 1692,1698 ----
  def canvas mouseup {x y b} {
      global canvas_mouseup wire_from wire_to _ font look offset_wire
!     set c .x$self.c
!     set cx [$c canvasx $x]
!     set cy [$c canvasy $y]
      if {[llength $wire_from]} {
          if {[llength $wire_to]} {
***************
*** 1755,1760 ****
    	#maybe don't need this
    	set _($wire_id) $d
! 		wire_update $wire_id $d;
! 		wire_draw2 $wire_id $name;
    	#pd "$self add-wire x$wire_from x$wire_to ;"
    	#puts "::::connect from $wire_from to $wire_to"
--- 1733,1738 ----
    	#maybe don't need this
    	set _($wire_id) $d
! 		wire_update $wire_id $d
! 		wire_draw2 $wire_id $c
    	#pd "$self add-wire x$wire_from x$wire_to ;"
    	#puts "::::connect from $wire_from to $wire_to"
***************
*** 1765,1774 ****
    set wire_from {}
    set wire_to {}
! 	$name delete lnew
    #return
      }
!     if {[llength [$canvas gettags selrect]] > 0} {
      	#puts "___figure out what objects are in selrect!!!"
!         set coords [$canvas coords selrect]
    set x1 [lindex $coords 0]
    set y1 [lindex $coords 1]
--- 1743,1752 ----
    set wire_from {}
    set wire_to {}
! 	$c delete lnew
    #return
      }
!     if {[llength [$c gettags selrect]] > 0} {
      	#puts "___figure out what objects are in selrect!!!"
!         set coords [$c coords selrect]
    set x1 [lindex $coords 0]
    set y1 [lindex $coords 1]
***************
*** 1778,1784 ****
    #puts "selrect area ::: $x1 $y1, $x2 $y2"
    # my selrect code begins --chun
!   	set selrect_id [$canvas find withtag selrect]
    	#puts "selrect's id ::: $selrect_id"
! 	set selected_elements [$canvas find overlapping $x1 $y1 $x2 $y2]
          #puts "elements in selrect --> $selected_elements"
          set selrect_index [lsearch $selected_elements $selrect_id]
--- 1756,1762 ----
    #puts "selrect area ::: $x1 $y1, $x2 $y2"
    # my selrect code begins --chun
!   	set selrect_id [$c find withtag selrect]
    	#puts "selrect's id ::: $selrect_id"
! 	set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
          #puts "elements in selrect --> $selected_elements"
          set selrect_index [lsearch $selected_elements $selrect_id]
***************
*** 1791,1795 ****
          	set element_tags {}
      		foreach item $selected_elements {
! 			eval lappend element_tags [$canvas gettags $item]
    	}
    	#puts "tags in selrect --> $element_tags"
--- 1769,1773 ----
          	set element_tags {}
      		foreach item $selected_elements {
! 			eval lappend element_tags [$c gettags $item]
    	}
    	#puts "tags in selrect --> $element_tags"
***************
*** 1801,1805 ****
    		}
    		# this would make things shorter		
! 			# if {[regexp {^l([a-f0-9]{6,8})} [$canvas gettags $tag] id]}
    		#if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {
    		#	
--- 1779,1783 ----
    		}
    		# this would make things shorter		
! 			# if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]}
    		#if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {
    		#	
***************
*** 1838,1842 ****
    				foreach wire_id $_($obj:0:$x) {
    					#wire_update $wire_id $_($wire_id) 
! 						#wire_draw2 $wire_id $canvas
    					set i [lsearch $@selection_wire $wire_id]
    					if {$i<0} {lappend @selection_wire $wire_id} 
--- 1816,1820 ----
    				foreach wire_id $_($obj:0:$x) {
    					#wire_update $wire_id $_($wire_id) 
! 						#wire_draw2 $wire_id $self
    					set i [lsearch $@selection_wire $wire_id]
    					if {$i<0} {lappend @selection_wire $wire_id} 
***************
*** 1849,1853 ****
    				foreach wire_id $_($obj:1:$x) {
    					#wire_update $wire_id $_($wire_id) 
! 						#wire_draw2 $wire_id $canvas
    					set i [lsearch $@selection_wire $wire_id]
    					if {$i<0} {lappend @selection_wire $wire_id} 
--- 1827,1831 ----
    				foreach wire_id $_($obj:1:$x) {
    					#wire_update $wire_id $_($wire_id) 
! 						#wire_draw2 $wire_id $self
    					set i [lsearch $@selection_wire $wire_id]
    					if {$i<0} {lappend @selection_wire $wire_id} 
***************
*** 1859,1863 ****
    	#puts "@selection_wire --> $@selection_wire"
      		foreach obj $@selection) {
-     			#puts "${obj}BASE :: $canvas"
      			$canvas itemconfigure ${obj}BASE -outline $look(objectframe4)
      		}
--- 1837,1840 ----
***************
*** 1867,1871 ****
      		set @select_by "selrect"
    } {
- 		#puts "dehightlight all!!!!!"
        		#foreach obj $@selection {
        		#$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
--- 1844,1847 ----
***************
*** 1873,1884 ****
        		#set @selection {}
    }
- 	# my selrect code ends
    $canvas delete selrect
      }
if {[llength $@selection]==1} {
-     	#puts "___only one obj selected by click!!!"
    #pd "$self gobj-activate x$@selection;"
- 	#puts "____ selected by ->$@select_by ____"
    if {$@select_by == "click"} {
    	switch $_($@selection:class) {
--- 1849,1857 ----
***************
*** 1895,1902 ****
      set edit 0; switch $@mode { edit { set edit 1 } }
      set run [expr !$edit]
- 
-     #not sure what this does 
-     #puts "mouseup2::: @focus => $@focus"
-     
      if {[string length $@focus]} {
    set id $@focus
--- 1868,1871 ----
***************
*** 1979,1985 ****
  def canvas key {x y key iso shift} {
      global OS
!     set canvas $self.c
! #    .controls.switches.meterbutton configure -text $key
!     hide_canvas_tooltip $canvas
      switch $OS {
        osx {
--- 1948,1953 ----
  def canvas key {x y key iso shift} {
      global OS
!     set c .x$self.c
!     $c hide_tooltip
      switch $OS {
        osx {
***************
*** 1992,2023 ****
      if {$key == "KP_Delete"} {set key 127; set keynum 127}
      if {$iso != ""} {scan $iso %c key}
!     #pd [canvastosym $canvas] key 1 $key $shift;
!     set edit 0; switch $_($self:mode) { edit { set edit 1 } }
!     puts "focus = $_($self:focus)"
!     #puts "key = $key"
!     
      if {$key == 8} {
!     	#puts "delete something"
! 	#puts "object selected=> [llength $_($self:selection)] => $_($self:selection)"
! 	if {[llength $_($self:selection)] > 0} {canvas_delete_selection $self}
! 	if {[llength $_($self:selection_wire)] > 0} {
! 		#$canvas delete $_($self:selection_wire)
! 		foreach wire $_($self:selection_wire) {
! 			$canvas delete $wire
! 		}
! 		set _($self:selection_wire) {}
    }
      }
- 
-     #mmm, don't know what this does.... -- chun
-     #if {[string length $_($self:focus)] > 0} {
- 	#set id $_($self:focus)
-         #set run [expr !$edit]
-         #if {$run && [info exists _($id:keyevent)]} { 
- 	#	eval [linsert [list $_($self:focus) $canvas $key $shift] 0 $_($id:keyevent)]
-         #} elseif {!$run && [info exists _($id:keyeditevent)]} {
- 	#	eval [linsert [list $_($self:focus) $canvas $key $shift] 0 $_($id:keyeditevent)]
- 	#}
-     #}
      statusbar_update $self $x $y
  }
--- 1960,1982 ----
      if {$key == "KP_Delete"} {set key 127; set keynum 127}
      if {$iso != ""} {scan $iso %c key}
!     set edit 0; switch $@mode { edit { set edit 1 } }
!     puts "focus = $@focus"
      if {$key == 8} {
! 	if {[llength $@selection] > 0} {$self delete_selection}
! 	if {[llength $@selection_wire] > 0} {
! 		$c delete $@selection_wire
! 		foreach wire $@selection_wire {$c delete $wire}
! 		set @selection_wire {}
! 	}
!     }
!     if {[string length $@focus] > 0} {
! 	set id $@focus
!         set run [expr !$edit]
!         if {$run && [info exists _($id:keyevent)]} { 
! 		eval [linsert [list $_($self:focus) $self $key $shift] 0 $_($id:keyevent)]
!         } elseif {!$run && [info exists _($id:keyeditevent)]} {
! 		eval [linsert [list $_($self:focus) $self $key $shift] 0 $_($id:keyeditevent)]
    }
      }
      statusbar_update $self $x $y
  }
***************
*** 3017,3021 ****
  set tooltip(mx) -1000
  set tooltip(my) -1000
! set tooltip(canvas) foo
  set tooltip(visible) 0
  set tooltip(text) ""
--- 2976,2980 ----
  set tooltip(mx) -1000
  set tooltip(my) -1000
! set tooltip(canvas) ""
  set tooltip(visible) 0
  set tooltip(text) ""
***************
*** 3024,3028 ****
    global current_x current_y tooltip
    if {$tooltip(visible) && [string compare $text $tooltip(text)==0]} {return}
! 	hide_canvas_tooltip $canvas
    set border 4
    set x [expr $x+$border+4]
--- 2983,2987 ----
    global current_x current_y tooltip
    if {$tooltip(visible) && [string compare $text $tooltip(text)==0]} {return}
! 	$self hide_tooltip
    set border 4
    set x [expr $x+$border+4]
***************
*** 3039,3043 ****
    set tooltip(mx) $current_x
    set tooltip(my) $current_y
! 	set tooltip(canvas) $canvas
    set tooltip(visible) 1
    set tooltip(text) $text
--- 2998,3002 ----
    set tooltip(mx) $current_x
    set tooltip(my) $current_y
! 	set tooltip(canvas) $self
    set tooltip(visible) 1
    set tooltip(text) $text