Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24091
Modified Files: Tag: devel_0_39 desire.tk Log Message: [lastlevel] gives the length of the callstack minus one Tcl box now evals in the global frame using [lastlevel]
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.199 retrieving revision 1.1.2.200 diff -C2 -d -r1.1.2.199 -r1.1.2.200 *** desire.tk 6 May 2006 23:46:40 -0000 1.1.2.199 --- desire.tk 7 May 2006 04:36:09 -0000 1.1.2.200 *************** *** 18,22 **** --- 18,29 ---- #-----------------------------------------------------------------------------------# # some list processing functions and some math too + # these could become another library like objective.tcl + # if they become substantial enough
+ # min finds the smallest of two values + # max finds the biggest of two values + # [clip $v $min $max] does [max $min [min $max $v]] + proc min {x y} {if {$x<$y} {return $x} {return $y}} + proc max {x y} {if {$x>$y} {return $x} {return $y}} proc clip {x min max} { if {$x<$min} {return $min} *************** *** 24,37 **** return $x } ! proc min {x y} {if {$x<$y} {return $x} {return $y}} ! proc max {x y} {if {$x>$y} {return $x} {return $y}} proc mset {vars list} {uplevel 1 "foreach {$vars} {$list} {}"} 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} proc lzip {op al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a $op $b]}; return $r} proc lmap {op al } {set r {}; foreach a $al b $bl {lappend r [expr $a $op ]}; return $r} proc l/2 { al } {set r {}; foreach a $al {lappend r [expr $a / 2]}; return $r} 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} proc lreverse {list} { set r {} --- 31,54 ---- return $x } ! ! # set several variables from elements of a list proc mset {vars list} {uplevel 1 "foreach {$vars} {$list} {}"} + + # add or substract one value to a list 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} proc lmap {op al } {set r {}; foreach a $al b $bl {lappend r [expr $a $op ]}; 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 proc lreverse {list} { set r {} *************** *** 40,43 **** --- 57,62 ---- }
+ # list substraction is like set substraction but order-preserving + # this is the same algorithm as Ruby's - operation on Arrays proc lwithout {a b} { set r {} *************** *** 47,50 **** --- 66,70 ---- }
+ # removes duplicates from a list, but it must be already sorted. proc luniq {a} { set r {} *************** *** 58,61 **** --- 78,94 ---- }
+ # finds the current length of the callstack, minus one. + # uplevel [thislevel] {...} gives access to the global context. + proc lastlevel {} { + set m 0; set n 1 + while {![catch {uplevel $n {}}]} {set m $n; incr n $n} + # from now on, m <= lastlevel < n + while {$n-$m>1} { + set p [expr ($m+$n)/2] + if {[catch {uplevel $p {}}]} {set n $p} {set m $p} + } + return [expr $m-1] + } + #-----------------------------------------------------------------------------------# # Observer pattern *************** *** 3115,3119 **** }
! proc tcl_eval {self l} {post %s "tcl: $l"; post %s "returns: [eval $l]"} proc pd_eval {self l} {post %s "pd: $l"; pd $l} proc gdb_eval {self l} {post %s "gdb: $l"; global gdb; puts $gdb "$l"} --- 3148,3152 ---- }
! proc tcl_eval {self l} {post %s "tcl: $l"; post %s "returns: [uplevel [lastlevel] $l]"} proc pd_eval {self l} {post %s "pd: $l"; pd $l} proc gdb_eval {self l} {post %s "gdb: $l"; global gdb; puts $gdb "$l"}