[PD-cvs] pd/src desire.tk,1.1.2.522,1.1.2.523

chunlee chunlee at users.sourceforge.net
Mon Oct 23 18:06:37 CEST 2006


Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10013

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
some small fixes here and there, mostly to do with gop


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.522
retrieving revision 1.1.2.523
diff -C2 -d -r1.1.2.522 -r1.1.2.523
*** desire.tk	21 Oct 2006 00:52:09 -0000	1.1.2.522
--- desire.tk	23 Oct 2006 16:06:34 -0000	1.1.2.523
***************
*** 1047,1055 ****
  
  def View item_delete {{suffix all}} {
!   set c [$@canvas widget]
! 	if {![winfo exists $c]} {return}
!   switch -- $suffix {
!     all     {$c delete $self       }
!     default {$c delete $self$suffix}}
  }
  
--- 1047,1058 ----
  
  def View item_delete {{suffix all}} {
! 	set c [$@canvas widget]
! 	if {![winfo exists $c]} {
! 		set c [[$@canvas get_canvas] widget]
! 		if {![winfo exists $c]} {return}
! 	}
! 	switch -- $suffix {
! 		all     {$c delete $self       }
! 		default {$c delete $self$suffix}}
  }
  
***************
*** 1857,1861 ****
  		-bg [$c itemcget ${self}BASE -fill] -borderwidth 0 -highlightthickness 0\
  	        -font $font_str -fg [$self look fg] -insertbackground [$self look fg]
! 	bind $t <Key> "$self resize; $self key %W %x %y %K %A 0"
  	bind $t <Control-Return> "$self key %W %x %y 10 %A 0"
  	bind $t <Return>         "$self unedit"
--- 1860,1864 ----
  		-bg [$c itemcget ${self}BASE -fill] -borderwidth 0 -highlightthickness 0\
  	        -font $font_str -fg [$self look fg] -insertbackground [$self look fg]
! 	bind $t <Key> "$self resize %K; $self key %W %x %y %K %A 0"
  	bind $t <Control-Return> "$self key %W %x %y 10 %A 0"
  	bind $t <Return>         "$self unedit"
***************
*** 1866,1878 ****
  	$t configure -pady 0 -padx 1
  	$t insert 1.0 $@text
! 	$self resize
  	focus $t
  }
  
! def TextBox resize {} {
  	set c [$@canvas widget]
  	set t $c.${self}text
! 	$self long_line 
! 	$t configure -width [string length [$t get $@longline.0 "$@longline.end + 1 chars"]]
  }
  
--- 1869,1883 ----
  	$t configure -pady 0 -padx 1
  	$t insert 1.0 $@text
! 	$self resize none
  	focus $t
  }
  
! def TextBox resize {key} {
  	set c [$@canvas widget]
  	set t $c.${self}text
! 	$self long_line
! 	set width [string length [$t get $@longline.0 "$@longline.end + 1 chars"]]
! 	if {$key == "BackSpace"} {set width [expr $width - 1]}
! 	$t configure -width $width
  }
  
***************
*** 1907,1913 ****
  }
  
! def TextBox text {} {
! 	return $@text
! }
  
  def TextBox update_size {} {
--- 1912,1916 ----
  }
  
! def TextBox text {} {return $@text}
  
  def TextBox update_size {} {
***************
*** 1937,1946 ****
  	}
  	catch {
- 		set n [expr [string length [$c.${self}text get $@longline.0 $@longline.end]] -1]
  		mset {x1 y1 w h} [$c.${self}text bbox $@longline.$n]
! 		set textwidth [expr ($padx + $x1 + ($w * 2)+$padx+2) / [$@canvas zoom]]
! 		# this might work better......
! 		#set textwidth [expr [string length [$c.${self}text get $@longline.0 $@longline.end]] * $w \
! 		#		   + $padx*2]
  	}
  	set iowidth [$self look iowidth]
--- 1940,1946 ----
  	}
  	catch {
  		mset {x1 y1 w h} [$c.${self}text bbox $@longline.$n]
! 		set textlen [string length [$c.${self}text get $@longline.0 $@longline.end]]
! 		set textwidth [expr $textlen * $w + $padx*2 + 2]
  	}
  	set iowidth [$self look iowidth]
***************
*** 2418,2477 ****
  #  nothing             : nothing
  def Canvas identify_target {x y f} {
!     set c [$self widget]
!     set cx [expr $x*$@zoom]
!     set cy [expr $y*$@zoom]
!     #doesn't do anything yet
!     #if {$@action != "none"} {set range 2} else {set range 2}
!     #set stack [lreverse [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]]
!     set stack [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]
! 	#puts "stack:::: $stack"
  
! 	#foreach tag $stack { puts "tags::: [$c gettags $tag]"}
!     foreach tag $stack {
! 	set tags [$c gettags $tag]
! #	    puts "  tags::::: $tags"
! 	if {[regexp {^[xo][0-9a-f]{6,8}} $tags id]} {
! 	    # prior to Aug 15th, Wires had lower priority as all objects together
! 	    # now it's same priority, so just stacking order (and it's prolly wrong)
! 	    set class [$id class]
! 	    if {[$self == $id]} {continue}
! 	    if {[$class <= Wire]} {if {$@action != "imove"} {return [list "wire" $id]}}
! 	    if {[$class <= Box]} {
! 		    if {$@action == "imove"} {
! 			    foreach tag $stack {
! 				    set tags2 [$c gettags $tag]
! 				    if {[regexp {^[xo][0-9a-f]{6,8}} $tags2 id]} {
! 					    set class [$id class]
! 					    if {[$class <= Wire]} {return [list "wire" $id]}
! 				    }
! 			    }
! 		    }
! 	      mset {x1 y1 x2 y2} [$id bbox]
! 	      set outs [$id noutlets]
! 	      set  ins [$id  ninlets]
! 	      if {$y>=$y2-6 && $outs} {
! 		      set val [expr int(($x-$x1)*$outs/($x2-$x1))]
! 		      if {$val == $outs} {set val [expr $val-1]}
! 		      return [list "outlet" $id $val]
! 	      }
! 	      if {$y< $y1+2 &&  $ins} {
! 		      set val [expr int(($x-$x1)* $ins/($x2-$x1))]
! 		      if {$val == $ins} {set val [expr $val-1]}
! 		      return [list  "inlet" $id $val]
! 	      }
! 	      #if {$class != "Canvas"} { return [list "object" $id]}
! 	    if {$class == "Canvas" && [$id gop]} {
! 		    if {[llength $stack] == 1} { return [list "object" $id]}
! 	    } else {
! 		    return [list "object" $id]
! 	    }
! 	    }
! 	    #puts "skipped a $class"
!         }
!     }
!     foreach tag $stack {
! 	set tags [$c gettags $tag]
!     }
!     return [list "nothing"]
  }
  
--- 2418,2475 ----
  #  nothing             : nothing
  def Canvas identify_target {x y f} {
! 	set c [$self widget]
! 	set cx [expr $x*$@zoom]
! 	set cy [expr $y*$@zoom]
! 	#doesn't do anything yet
! 	#if {$@action != "none"} {set range 2} else {set range 2}
! 	set stack [$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 {^[xo][0-9a-f]{6,8}} $tags id]} {
! 			# prior to Aug 15th, Wires had lower priority as all objects together
! 			# now it's same priority, so just stacking order (and it's prolly wrong)
! 			set class [$id class]
! 			if {[$self == $id]} {continue}
! 			if {[$class <= Wire]} {if {$@action != "imove"} {return [list "wire" $id]}}
! 			if {[$class <= Box]} {
! 				if {$@action == "imove"} {
! 					foreach tag $stack {
! 						set tags2 [$c gettags $tag]
! 						if {[regexp {^[xo][0-9a-f]{6,8}} $tags2 id]} {
! 							set class [$id class]
! 							if {[$class <= Wire]} {return [list "wire" $id]}
! 						}
! 					}
! 				}
! 				mset {x1 y1 x2 y2} [$id bbox]
! 				set outs [$id noutlets]
! 				set  ins [$id  ninlets]
! 				if {$y>=$y2-6 && $outs} {
! 					set val [expr int(($x-$x1)*$outs/($x2-$x1))]
! 					if {$val == $outs} {set val [expr $val-1]}
! 					return [list "outlet" $id $val]
! 				}
! 				if {$y< $y1+2 &&  $ins} {
! 					set val [expr int(($x-$x1)* $ins/($x2-$x1))]
! 					if {$val == $ins} {set val [expr $val-1]}
! 					return [list  "inlet" $id $val]
! 				}
! 				# deals with GOP 
! 				if {$@editmode} {
! 					return [list "object" $id]
! 				} else {
! 					if {$class == "Canvas" && [$id gop]} {
! 						if {[llength $stack] == 1} { return [list "object" $id]}
! 					} else {return [list "object" $id]}
! 				}
! 			}
! 			#puts "skipped a $class"
! 		}
! 	}
! 	foreach tag $stack {
! 		set tags [$c gettags $tag]
! 	}
! 	return [list "nothing"]
  }
  
***************
*** 2829,2833 ****
  		set objects [lsort -unique $objects]
  		set wires   [lsort -unique $wires]
! 		$@canvas selection+= $objects
  		$@canvas selection_wire+= $wires
  	}
--- 2827,2834 ----
  		set objects [lsort -unique $objects]
  		set wires   [lsort -unique $wires]
! 		set objects2 {}
! 		#so that objects in gop won't get selected...
! 		foreach obj $objects {if {[$obj canvas] == $@canvas} {lappend objects2 $obj}}
! 		$@canvas selection+= $objects2
  		$@canvas selection_wire+= $wires
  	}
***************
*** 2935,2939 ****
  
  def Canvas right_click {id x y} {
! 	if {!$@editmode} {return}
  	set c [$self widget]
  	set @insert_x $x; set @insert_y $y
--- 2936,2940 ----
  
  def Canvas right_click {id x y} {
! 	#if {!$@editmode} {return}
  	set c [$self widget]
  	set @insert_x $x; set @insert_y $y
***************
*** 3496,3503 ****
  	#update/move the content of gop 
  	if {[$self class] == "Canvas"} {
! 		if {[$self gop] && ![winfo exists .$self.c]} {
! 			#foreach x $@children {$x changed}
! 			foreach x $@visible_children {$x changed}
! 		}
  	} else {
  		$self changed_wires
--- 3497,3501 ----
  	#update/move the content of gop 
  	if {[$self class] == "Canvas"} {
! 		if {[$self gop] && ![winfo exists .$self.c]} {foreach x $@visible_children {$x changed}}
  	} else {
  		$self changed_wires
***************
*** 3515,3518 ****
--- 3513,3519 ----
  	pd .$@canvas object_moveto !$self $x1 $y1
  	[$@canvas history] add [list $self moveto $@x1 $@y1]
+ 	if {[$self class] == "Canvas"} {
+ 		if {[$self gop] && ![winfo exists .$self.c]} {foreach x $@visible_children {$x changed}}
+ 	}
  	set @x1 $x1
  	set @y1 $y1
***************
*** 5576,5580 ****
  			switch $self {
  				browser {$self fill_box [$@textbox get]}
! 				completion {$self adjust_box; $@textself resize; $@textself changed}
  			}
  		}
--- 5577,5581 ----
  			switch $self {
  				browser {$self fill_box [$@textbox get]}
! 				completion {$self adjust_box; $@textself resize BackSpace; $@textself changed}
  			}
  		}
***************
*** 5606,5610 ****
  	if {[focus] == $@textbox & $key != "Tab"} {
  		$self adjust_box
! 		$@textself resize
  		#hum, no idea why i need after 1 for it to work...
  		after 1 $@textself after_key $@textbox
--- 5607,5611 ----
  	if {[focus] == $@textbox & $key != "Tab"} {
  		$self adjust_box
! 		$@textself resize none
  		#hum, no idea why i need after 1 for it to work...
  		after 1 $@textself after_key $@textbox





More information about the Pd-cvs mailing list