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 }