[PD-cvs] pd/src desire.tk,1.1.2.600.2.25,1.1.2.600.2.26
Mathieu Bouchard
matju at users.sourceforge.net
Wed Dec 6 09:12:26 CET 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7403
Modified Files:
Tag: desiredata
desire.tk
Log Message:
some not-too-successful attempts at speeding up desire.tk
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.25
retrieving revision 1.1.2.600.2.26
diff -C2 -d -r1.1.2.600.2.25 -r1.1.2.600.2.26
*** desire.tk 6 Dec 2006 02:41:05 -0000 1.1.2.600.2.25
--- desire.tk 6 Dec 2006 08:12:23 -0000 1.1.2.600.2.26
***************
*** 42,46 ****
package require poe
if {$tk} {package require bgerror}
! #catch {package require Tclx}
#if {[catch {source profile_dd.tcl}]} {error_dump}
--- 42,46 ----
package require poe
if {$tk} {package require bgerror}
! catch {package require Tclx}
#if {[catch {source profile_dd.tcl}]} {error_dump}
***************
*** 77,95 ****
# add or substract two lists
! proc l+ { al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a + $b]}; return $r}
! proc l- { al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a - $b]}; return $r}
# like l+ or l- but for any infix supported by expr
! proc lzip {op al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a $op $b]}; return $r}
# do an operation between all elements of a list and a second argument
! proc lmap {op al b } {set r {}; foreach a $al {lappend r [expr $a $op $b]}; return $r}
!
! # halve a list
! proc l/2 { al } {set r {}; foreach a $al {lappend r [expr $a / 2]}; return $r}
# sum and product of a list, like math's capital Sigma and capital Pi.
! proc lsum {al} {set r 0; foreach a $al {set r [expr $r+$a]}; return $r}
! proc lprod {al} {set r 1; foreach a $al {set r [expr $r*$a]}; return $r}
# all elements from end to beginning
--- 77,104 ----
# add or substract two lists
! proc l+ { al bl} {set r {}; foreach a $al b $bl {lappend r [expr {$a+$b}]}; return $r}
! proc l- { al bl} {set r {}; foreach a $al b $bl {lappend r [expr {$a-$b}]}; return $r}
! # halve a list
! proc l/2 { al } {set r {}; foreach a $al {lappend r [expr {$a/2}]}; return $r}
# like l+ or l- but for any infix supported by expr
! proc lzip {op al bl} {
! set r {}
! set e "\$a $op \$b"
! foreach a $al b $bl {lappend r [expr $e]}
! return $r
! }
# do an operation between all elements of a list and a second argument
! proc lmap {op al b } {
! set r {}
! set e "\$a $op \$b"
! foreach a $al {lappend r [expr $e]}
! return $r
! }
# sum and product of a list, like math's capital Sigma and capital Pi.
! proc lsum {al} {set r 0; foreach a $al {set r [expr {$r+$a}]}; return $r}
! proc lprod {al} {set r 1; foreach a $al {set r [expr {$r*$a}]}; return $r}
# all elements from end to beginning
***************
*** 710,714 ****
. configure -menu .mbar
wm title . "DesireData"
! wm iconphoto . icon_pd
post "DesireData 0.39.A, Tcl %s, Tk %s" $::tcl_patchLevel $::tk_patchLevel
}
--- 719,723 ----
. configure -menu .mbar
wm title . "DesireData"
! catch {wm iconphoto . icon_pd}
post "DesireData 0.39.A, Tcl %s, Tk %s" $::tcl_patchLevel $::tk_patchLevel
}
***************
*** 2115,2142 ****
set c [$@canvas widget]
set t $c.${self}text
! set padx [$self look fontpadx];set pady [$self look fontpady]
set width [font measure [$self look font] W]
#set width [$self look fontwidth];set height [$self look fontheight]
if {[winfo exists $c.${self}text]} {
! set height [expr [lindex [$t configure -height] 4] * \
! [font metrics [$self look font] -linespace]]
} else {
- set height [expr [font metrics [$self look font] -linespace] * $nl]
}
#set height [expr [font metrics [$self look font] -linespace] * $nl]
! set textwidth [expr $padx+$width*($n+$@edit)]
if {[llength [$c gettags ${self}TEXT]]} {
mset {x1 y1 x2 y2} [$c bbox ${self}TEXT]
! set textwidth [expr (($x2 - $x1)/[$@canvas zoom])+$padx]
}
catch {
set text [$c.${self}text get $@longline.0 $@longline.end]
! set textwidth [expr [font measure [$self look font] $text]+$padx*2+2]
}
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]
}
#-----------------------------------------------------------------------------------
--- 2124,2152 ----
set c [$@canvas widget]
set t $c.${self}text
! set padx [$self look fontpadx]
! set pady [$self look fontpady]
set width [font measure [$self look font] W]
#set width [$self look fontwidth];set height [$self look fontheight]
+ set ls [font metrics [$self look font] -linespace]
if {[winfo exists $c.${self}text]} {
! set nl [lindex [$t configure -height] 4]
} else {
}
+ set height [expr {$nl*$ls}]
#set height [expr [font metrics [$self look font] -linespace] * $nl]
! set textwidth [expr {$padx+$width*($n+$@edit)}]
if {[llength [$c gettags ${self}TEXT]]} {
mset {x1 y1 x2 y2} [$c bbox ${self}TEXT]
! set textwidth [expr {(($x2 - $x1)/[$@canvas zoom])+$padx}]
}
catch {
set text [$c.${self}text get $@longline.0 $@longline.end]
! set textwidth [expr {[font measure [$self look font] $text]+$padx*2+2}]
}
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}]
}
#-----------------------------------------------------------------------------------
***************
*** 2196,2205 ****
}
def ObjectBox draw_box {} {
- global font
super
set xya [$self bbox]
mset {x1 y1 x2 y2} $xya
! set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
! set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
if {[$self selected?]} {set fg [$self look selectframe]} {set fg [$self look frame3]}
$self item BASE rectangle $xya -fill [$self look bg] -outline $fg -width 1
--- 2206,2214 ----
}
def ObjectBox draw_box {} {
super
set xya [$self bbox]
mset {x1 y1 x2 y2} $xya
! #set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
! #set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
if {[$self selected?]} {set fg [$self look selectframe]} {set fg [$self look frame3]}
$self item BASE rectangle $xya -fill [$self look bg] -outline $fg -width 1
***************
*** 3966,3984 ****
def Box bbox {} {
mset {x y} [$self xy]
! list $x $y [expr $x+$@xs] [expr $y+$@ys]
}
def Box io_bbox {type port n} {
! set nplus [expr $n==1 ? 1 : $n-1]
mset {x1 y1 x2 y2} [$self bbox]
! set xs [expr $x2 - $x1]
! set iowidth [$self look iowidth]
! set fy [$self look iopos]
switch $type {
! o {set n $@noutlets; set y $y2+$fy }
! i {set n $@ninlets; set y $y1-$fy-1}
}
! set onset [expr $x1 + ($xs-$iowidth) * $port / $nplus]
! set points [list [expr $onset] [expr $y-0] [expr $onset+$iowidth] [expr $y+0]]
return $points
}
--- 3975,3998 ----
def Box bbox {} {
mset {x y} [$self xy]
! set xs $@xs
! set ys $@ys
! list $x $y [expr {$x+$xs}] [expr {$y+$ys}]
}
def Box io_bbox {type port n} {
! set nplus [expr {$n==1 ? 1 : $n-1}]
mset {x1 y1 x2 y2} [$self bbox]
! set xs [expr {$x2-$x1}]
! # method calls aren't as fast as we'd want them to.
! #set iowidth [$self look iowidth]
! #set fy [$self look iopos]
! set iowidth 7
! set fy -1
switch $type {
! o {set n $@noutlets; set y [expr {$y2+$fy }]}
! i {set n $@ninlets; set y [expr {$y1-$fy-1}]}
}
! set onset [expr {$x1+($xs-$iowidth)*$port/$nplus}]
! set points [list $onset [expr {$y-0}] [expr {$onset+$iowidth}] [expr {$y+0}]]
return $points
}
More information about the Pd-cvs
mailing list