Posted to tcl by aspect at Wed Nov 23 23:05:31 GMT 2016view raw

  1. proc proc* {name arglist body} {
  2. set upargs [lsearch -inline -all $arglist _*]
  3. if {[llength $upargs]} {
  4. set upvar [list ::upvar 1]
  5. foreach a $upargs {
  6. append upvar " \$$a [list [string range $a 1 end]]"
  7. }
  8. set body "$upvar;$body"
  9. }
  10. tailcall ::proc $name $arglist $body
  11. }
  12.  
  13.  
  14. # clamp saves some tedium and getting max/min confused
  15. proc* clamp {_x min max} {
  16. if {$x < $min} {set x $min}
  17. if {$x > $max} {set x $max}
  18. return $x
  19. }
  20.  
  21. # incrmod 10 i 3 -> 0 3 6 9 2 5 8 1 4 7 ..
  22. proc* incrmod {modulus _var {increment 1}} {
  23. set var [expr {($var + $increment) % $modulus}]
  24. }
  25.  
  26. # assertions, if nothing else, are a nice default error message
  27. proc assert {x {msg ""}} {
  28. if {![uplevel 1 expr [list $x]]} {
  29. catch {
  30. set y [uplevel 1 [list subst -noc $x]]
  31. if {$y ne $x} {
  32. set x "{$y} from {$x}"
  33. }
  34. }
  35. throw ASSERT "[concat "Assertion failed!" $msg] $x"
  36. }
  37. }
  38.  
  39.  
  40. proc test {} {
  41. set a 12
  42. assert {[clamp a 0 10] == 10}
  43. assert {[clamp a 5 15] == 10}
  44. assert {[clamp a 12 20] == 12}
  45. assert {[incrmod 12 a 1] == 1}
  46. }
  47.  
  48. test
  49.