[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