Posted to tcl by Stu at Fri May 26 00:03:07 GMT 2023view raw

  1. # Cascade by Stu
  2.  
  3. oo::class create Cascade {
  4. method cascade {{blob {}} {ch "`"}} {
  5. if {$ch eq ""} { set ch "`" }
  6. tailcall my Cascade [lmap {op script} [regexp -inline -all [format {([^%s].*?)(?:%s|$)} $ch $ch] $blob] {
  7. if {[set mop [string index $script 0]] in [list ? =]} {
  8. set op $mop
  9. set script [string range $script 1 end]
  10. }
  11. if {[set script [string trim $script]] eq ""} continue
  12. list $op $script
  13. }]
  14. }
  15. method Cascade {{todo {}}} {
  16. if {[llength $todo] == 0} { return "" }
  17. set todo [lassign $todo do]
  18. lassign $do op script
  19. set err [catch {uplevel 1 [regsub ^ $script "[self] "]} res opts]
  20. if { [llength $todo] == 0
  21. || ($op eq "?" && [expr {!$res}])
  22. || $err
  23. } { return -code [dict get $opts -code] $res }
  24. tailcall my Cascade $todo
  25. }
  26. }; # oo::class create Cascade
  27.  
  28.  
  29.  
  30.  
  31. oo::class create ValuetteMethods {
  32. variable val opt
  33. method ign {args} {}
  34. foreach m {val opt} {method $m {args} [format \
  35. {expr {[llength $args] > 0
  36. ? [set %s [lindex $args 0]]
  37. : $%s
  38. }
  39. } $m $m]}
  40. }; # oo::class create ValuetteMethods
  41.  
  42.  
  43. oo::class create Valuette {
  44. mixin ValuetteMethods Cascade
  45. variable val opt
  46. constructor {args} { lassign $args val opt }
  47. }; # oo::class create Valuette
  48.  
  49.  
  50.  
  51. oo::class create Channelle {
  52. mixin ValuetteMethods Cascade
  53. variable val opt
  54. constructor {{aChannel {}} {autoFlush {1}}} {
  55. set val [expr {$aChannel ne {} ? $aChannel : "stdout"}]
  56. set opt $autoFlush
  57. }
  58. method out {{blob {}}} {
  59. puts -nonewline $val $blob
  60. if {$opt} { my flush }
  61. }
  62. method flush {} { flush $val }
  63. method cr {} { my out \n }
  64. method chan {args} { my val {*}$args }
  65. method af {args} { my opt {*}$args }
  66. }; # oo::class create Channelle
  67.  
  68.  
  69.  
  70. oo::class create Numberre {
  71. mixin ValuetteMethods Cascade
  72. variable val opt
  73. constructor {{aNumber {0}} {hex {0}}} {
  74. set val $aNumber
  75. set opt $hex
  76. }
  77. foreach op [list + - * /] { method n$op {args} [format \
  78. {set val [::tcl::mathop::%s $val {*}$args]} $op \
  79. ]}
  80. method n== {num} { expr {$val == $num} }
  81. method n= {args} {
  82. format [expr {$opt ? "%x" : "%d"}] [my val {*}$args]
  83. }
  84. method hex {args} { my opt {*}$args }
  85. }; # oo::class create Numberre
  86.  
  87.  
  88.  
  89. oo::class create Stringette {
  90. mixin ValuetteMethods Cascade
  91. variable val opt
  92. constructor {{aString ""} {maxLen {10}}} {
  93. set val $aString
  94. set opt $maxLen
  95. }
  96. foreach op [list upper lower title] \
  97. mtd [list upr lwr ttl] {
  98. method $mtd {args} [format \
  99. {set val [string to%s $val]} $op]
  100. }
  101. method rev {} { my val [string reverse [my val]] }
  102. method s> {args} { my s= [string cat [my val] [join $args ""]] }
  103. method s< {args} { my s= [string cat [join $args ""] [my val]] }
  104. method s== {str} { expr {[my val] eq $str} }
  105. method s= {args} {
  106. my val {*}$args
  107. my val [string range [my val] 0 [my maxLen]-1]
  108. }
  109. method maxLen {args} { my opt {*}$args }
  110. }; # oo::class create Numberre
  111.  
  112.  
  113.  
  114.  
  115. if 1 {
  116.  
  117.  
  118. Valuette create val
  119.  
  120. puts [val cascade { val 123 ` val text}]
  121.  
  122. # result: text
  123.  
  124. puts ""
  125.  
  126.  
  127. Numberre create num
  128.  
  129. puts [list [num cascade {
  130. n= 2
  131. ` n* 2 3
  132. ` n- 5
  133. `? n== 3
  134. ` n= -1
  135. }] [num n=]]
  136.  
  137. # result: {0 7}
  138.  
  139.  
  140. puts ""
  141.  
  142. Channelle create chn
  143.  
  144. chn cascade {
  145. out "Hello "
  146. `out World
  147. `cr
  148. `af 0
  149. `out "Today is"
  150. `out " a"
  151. `flush
  152. `out " new Day"
  153. `af 1
  154. `out !
  155. `cr
  156. }
  157.  
  158. # result: output presumably
  159.  
  160.  
  161. puts ""
  162.  
  163. Stringette create str Too 15
  164.  
  165. puts [format "%s\n%s\n%s\n%s" [str cascade {
  166. rev ` s< "toH "
  167. ` rev ` s> " To"
  168. ` rev ` s< "ooH "
  169. ` rev
  170. ` s> t12345
  171. }] [str rev] [str cascade { s= [regsub -all {\s} [str s=] {}] ` upr }] \
  172. [str cascade { rev ` lwr}]]
  173.  
  174. # result: ?
  175.  
  176.  
  177. puts ""
  178.  
  179. chn cascade {
  180. af 1
  181. ` out "Num: "
  182. ` out [num cascade {
  183. n* 123
  184. < hex 1
  185. < n+ 2
  186. < n=
  187. } <]
  188. ` cr
  189. ` ign [val val C]
  190. ` cr
  191. ` out [str cascade {
  192. maxLen 20
  193. ~ s= [string range [str s=] 0 end-6]
  194. ~ s= [regsub {(oo)} [str s=] {\1 }]
  195. ~ s< "It's "
  196. ~ s> ": " [num cascade {
  197. hex 0
  198. ' n=
  199. } ']
  200. ~ s> [val val] !
  201. } ~]
  202. ` cr
  203. }
  204.  
  205. # It's a bit warm today ...
  206.  
  207.  
  208. }; # if 0/1
  209.  
  210.  
  211. # EOF
  212.  
  213.  
  214.  
  215.  
  216. if 0 {
  217. $ tclsh cascade.tcl
  218. text
  219.  
  220. 0 7
  221.  
  222. Hello World
  223. Today is a new Day!
  224.  
  225. Too Hot To Hoot
  226. tooH oT toH ooT
  227. TOOHOTTOHOOT
  228. toohottohoot
  229.  
  230. Num: 35f
  231.  
  232. It's too hot: 863C!
  233. }