[PD-cvs] pd/src desire.tk,1.1.2.432,1.1.2.433

Mathieu Bouchard matju at users.sourceforge.net
Thu Aug 31 14:19:05 CEST 2006


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
faster def View look


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.432
retrieving revision 1.1.2.433
diff -C2 -d -r1.1.2.432 -r1.1.2.433
*** desire.tk	31 Aug 2006 11:07:55 -0000	1.1.2.432
--- desire.tk	31 Aug 2006 12:19:03 -0000	1.1.2.433
***************
*** 436,442 ****
  proc say_category  {text} {}
  
- proc look2 {k} {global look; return $look($k)}
- proc look {class k} {global look; return $look($class:$k)}
- 
  set cmdline(server) [file join [file dirname $argh0] ../bin/pd]
  set cmdline(rcfilename) ~/.pdrc
--- 436,439 ----
***************
*** 999,1011 ****
  
  def View look {k} {
! 	global look
! 	if {[info exists look($@_class:$k)]} {
! 		return $look($@_class:$k)
! 	} else {
! 	        
  		foreach super [$@_class ancestors] {
! 			if {[info exists look($super:$k)]} {return $look($super:$k)}
  		}
  	}
  }
  
--- 996,1018 ----
  
  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 look_old {k} {
+ 	global look
+ 	if {[info exists look($@_class:$k)]} {return $look($@_class:$k)}
+ 	foreach super [$@_class ancestors] {
+ 		if {[info exists look($super:$k)]} {return $look($super:$k)}
+ 	}
  }
  
***************
*** 1658,1663 ****
  	#}
  	#set textwidth [expr $font(padx)+$font(width)*($n+$@edit)]
! 	set topwidth    [expr (2* $@ninlets-1) * [$self look iowidth]]
! 	set bottomwidth [expr (2*$@noutlets-1) * [$self look iowidth]]
  	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
  	set @ys [expr $pady+$height]
--- 1665,1671 ----
  	#}
  	#set textwidth [expr $font(padx)+$font(width)*($n+$@edit)]
! 	set iowidth [$self look iowidth]
! 	set topwidth    [expr (2* $@ninlets-1) * $iowidth]
! 	set bottomwidth [expr (2*$@noutlets-1) * $iowidth]
  	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
  	set @ys [expr $pady+$height]
***************
*** 2886,2894 ****
      mset {x1 y1 x2 y2} [$self bbox]
      set xs [expr $x2-$x1]
!     set ys [expr $y2-$y1]
      for {set i 0} {$i<$n} {incr i} {
!         set onset [expr $x1 + ($xs-([$self look iowidth])) * $i / $nplus]
!         set points [list [expr $onset] [expr $y-0] [expr $onset+[$self look iowidth]] [expr $y+0]]
! 	switch $which { i {set color [$self look inletfg]} o {set color [$self look outletfg]}}
  	$self item [list $which$i $which] rectangle $points -outline $color -fill $color -width 1
      }
--- 2894,2902 ----
      mset {x1 y1 x2 y2} [$self bbox]
      set xs [expr $x2-$x1]
!     set iowidth [$self look iowidth]
!     switch $which { i {set color [$self look inletfg]} o {set color [$self look outletfg]}}
      for {set i 0} {$i<$n} {incr i} {
!         set onset [expr $x1 + ($xs-$iowidth) * $i / $nplus]
!         set points [list [expr $onset] [expr $y-0] [expr $onset+$iowidth] [expr $y+0]]
  	$self item [list $which$i $which] rectangle $points -outline $color -fill $color -width 1
      }
***************
*** 2909,2913 ****
  	switch $type {i {set ports $@ninlets} o {set ports $@noutlets}}
  	set port -1
! 	
  	for {set n 0} {$n<$ports} {incr n} {
  		set tag $self$type$n
--- 2917,2922 ----
  	switch $type {i {set ports $@ninlets} o {set ports $@noutlets}}
  	set port -1
! 	set iowidth [$self look iowidth]
! 
  	for {set n 0} {$n<$ports} {incr n} {
  		set tag $self$type$n
***************
*** 2915,2919 ****
  		set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
  		set dist [expr abs($x - $center)]
! 		if {$dist < [expr ([$self look iowidth]/2)+5] && $dist > 0} {set port $n}
  	}
  
--- 2924,2928 ----
  		set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
  		set dist [expr abs($x - $center)]
! 		if {$dist < [expr ($iowidth/2)+5] && $dist > 0} {set port $n}
  	}
  
***************
*** 3609,3614 ****
  	#set width [$self look fontwidth];set height [$self look fontheight]
  	set textwidth [expr $padx+$width*$@w]
! 	set topwidth    [expr (2* $@ninlets-1) * [$self look iowidth]]
! 	set bottomwidth [expr (2*$@noutlets-1) * [$self look iowidth]]
  	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
  	set @ys [expr $pady+$height]
--- 3618,3624 ----
  	#set width [$self look fontwidth];set height [$self look fontheight]
  	set textwidth [expr $padx+$width*$@w]
! 	set iowidth [$self look iowidth]
! 	set topwidth    [expr (2* $@ninlets-1) * $iowidth]
! 	set bottomwidth [expr (2*$@noutlets-1) * $iowidth]
  	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
  	set @ys [expr $pady+$height]
***************
*** 3669,3674 ****
  	#set width [$self look fontwidth];set height [$self look fontheight]
  	set textwidth [expr $padx+$width*[string length $@buf]]
! 	set topwidth    [expr (2* $@ninlets-1) * [$self look iowidth]]
! 	set bottomwidth [expr (2*$@noutlets-1) * [$self look iowidth]]
  	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
  	set @ys  [expr $pady+$height]
--- 3679,3685 ----
  	#set width [$self look fontwidth];set height [$self look fontheight]
  	set textwidth [expr $padx+$width*[string length $@buf]]
! 	set iowidth [$self look iowidth]
! 	set topwidth    [expr (2* $@ninlets-1) * $iowidth]
! 	set bottomwidth [expr (2*$@noutlets-1) * $iowidth]
  	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
  	set @ys  [expr $pady+$height]
***************
*** 4003,4007 ****
  	mset {x1 y1 x2 y2} [$self bbox]
  	if {$@flash} {
! 		.$@canvas.c itemconfigure ${self}BUT -fill [color_* [look bg] [parse_color $@fcol]]
  		after 100 [list .$@canvas.c itemconfigure ${self}BUT -fill [color_* [$self look bg] [parse_color $@bcol]]]
  		set $@flash 0
--- 4014,4018 ----
  	mset {x1 y1 x2 y2} [$self bbox]
  	if {$@flash} {
! 		.$@canvas.c itemconfigure ${self}BUT -fill [color_* [$self look bg] [parse_color $@fcol]]
  		after 100 [list .$@canvas.c itemconfigure ${self}BUT -fill [color_* [$self look bg] [parse_color $@bcol]]]
  		set $@flash 0





More information about the Pd-cvs mailing list