pd/src desire.tk,1.1.2.600.2.28,1.1.2.600.2.29 - Pd-cvs

7 Dec 2006


      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
+ }