[PD-cvs] pd/src desire.tk,1.1.2.600.2.28,1.1.2.600.2.29

[Mathieu Bouchard]

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

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
accelerated def View look and def View item


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.28
retrieving revision 1.1.2.600.2.29
diff -C2 -d -r1.1.2.600.2.28 -r1.1.2.600.2.29
*** desire.tk	6 Dec 2006 20:07:32 -0000	1.1.2.600.2.28
--- desire.tk	6 Dec 2006 23:52:26 -0000	1.1.2.600.2.29
***************
*** 1085,1101 ****
  def View subpatch {} {if {[info exists @subpatch]} {return 1} else {return 0}}
  
! def View look {k} {
  	global look look_cache
! 	if {![info exists look_cache($@_class:$k)]} {
! 		foreach super [$@_class ancestors] {
! 			if {[info exists look($super:$k)]} {
! 				set look_cache($@_class:$k) $super
! 				break
! 			}
  		}
  	}
- 	set class $look_cache($@_class:$k)
- 	return $look($class:$k)
  }
  
  def View init {} {
--- 1085,1105 ----
  def View subpatch {} {if {[info exists @subpatch]} {return 1} else {return 0}}
  
! def View look_cache {k} {
  	global look look_cache
! 	foreach super [$@_class ancestors] {
! 		if {[info exists look($super:$k)]} {
! 			set look_cache($@_class:$k) $super
! 			return $super
  		}
  	}
  }
+ def View look {k} {
+ 	if {![info exists ::look_cache($@_class:$k)]} {$self look_cache $k}
+ 	return   $::look($::look_cache($@_class:$k):$k)
+ }
+ #def View look {k} {
+ #	if {[catch {set r $::look_cache($@_class:$k)}]} {set r [$self look_cache $k]}
+ #	return $::look($r:$k)
+ #}
  
  def View init {} {
***************
*** 1108,1112 ****
  }
  
! def View item {suffixes type coords args} {
  	global font
  	set canvas [$self get_canvas]
--- 1112,1116 ----
  }
  
! set item {
  	global font
  	set canvas [$self get_canvas]
***************
*** 1117,1128 ****
  	set find [lsearch $args "-width"]
  	if {$find >= 0} {
! 		set new_width [format %.0f [expr [lindex $args [expr $find+1]] * $zoom]]
! 		set args [lreplace $args [expr $find + 1] [expr $find + 1] $new_width]
  	}
  	set find [lsearch $args "-font"]
  	if {$find >= 0} {
! 		set font [lindex $args [expr $find + 1]]
! 		set new_size [format %.0f [expr [lindex $font 1]*$zoom]]
! 		set args [lreplace $args [expr $find + 1] [expr $find + 1] [lreplace $font 1 1 $new_size]]
  	}
  	set tags {}
--- 1121,1133 ----
  	set find [lsearch $args "-width"]
  	if {$find >= 0} {
! 		incr find
! 		set w [lindex $args $find]
! 		lset args $find [format %.0f [expr {$w*$zoom}]]
  	}
  	set find [lsearch $args "-font"]
  	if {$find >= 0} {
! 		incr find
! 		set fs [lindex [lindex $args $find] 1]
! 		lset args $find 1 [format %.0f [expr {$fs*$zoom}]]
  	}
  	set tags {}
***************
*** 1130,1141 ****
  	set ss [lindex $tags 0]
  	lappend tags [list $self]
  	if {![llength [$c gettags $ss]]} {
! 		eval  [concat [list $c create $type $coords  -tags $tags] $args]
  	} {
  		eval [concat [list $c itemconfigure $ss] $args]
  		eval [concat [list $c coords        $ss] $coords]
  	}
  }
! 
  
  def View item_delete {{suffix all}} {
--- 1135,1159 ----
  	set ss [lindex $tags 0]
  	lappend tags [list $self]
+ }
+ if {$tcl_version>=8.5} {
+     append item {
  	if {![llength [$c gettags $ss]]} {
! 		$c create $type $coords -tags $tags {expand}$args
! 	} {
! 		$c itemconfigure $ss {expand}$args
! 		$c coords        $ss {expand}$coords
! 	}
!     }
! } else {
!     append item {
! 	if {![llength [$c gettags $ss]]} {
! 		eval [concat [list $c create $type $coords -tags $tags] $args]
  	} {
  		eval [concat [list $c itemconfigure $ss] $args]
  		eval [concat [list $c coords        $ss] $coords]
  	}
+     }
  }
! def View item {suffixes type coords args} $item
  
  def View item_delete {{suffix all}} {
***************
*** 3990,3994 ****
  	}
  	set onset [expr {$x1+($xs-$iowidth)*$port/$nplus}]
! 	set points [list $onset [expr {$y-0}] [expr {$onset+$iowidth}] [expr {$y+0}]]
  	return $points
  }
--- 4008,4012 ----
  	}
  	set onset [expr {$x1+($xs-$iowidth)*$port/$nplus}]
! 	set points [list $onset $y [expr {$onset+$iowidth}] $y]
  	return $points
  }
***************
*** 7548,7549 ****
--- 7566,7575 ----
  	#vwait foo
  }
+ 
+ def Canvas auto_test {} {
+ 	$self editmode= 1
+ 	$self select_all
+ 	$self selection_move +10 0
+ 	$self selection_move +10 0
+ 	$self selection_move +10 0
+ }