Posted to tcl by Stu at Fri May 26 00:03:07 GMT 2023view pretty
# Cascade by Stu oo::class create Cascade { method cascade {{blob {}} {ch "`"}} { if {$ch eq ""} { set ch "`" } tailcall my Cascade [lmap {op script} [regexp -inline -all [format {([^%s].*?)(?:%s|$)} $ch $ch] $blob] { if {[set mop [string index $script 0]] in [list ? =]} { set op $mop set script [string range $script 1 end] } if {[set script [string trim $script]] eq ""} continue list $op $script }] } method Cascade {{todo {}}} { if {[llength $todo] == 0} { return "" } set todo [lassign $todo do] lassign $do op script set err [catch {uplevel 1 [regsub ^ $script "[self] "]} res opts] if { [llength $todo] == 0 || ($op eq "?" && [expr {!$res}]) || $err } { return -code [dict get $opts -code] $res } tailcall my Cascade $todo } }; # oo::class create Cascade oo::class create ValuetteMethods { variable val opt method ign {args} {} foreach m {val opt} {method $m {args} [format \ {expr {[llength $args] > 0 ? [set %s [lindex $args 0]] : $%s } } $m $m]} }; # oo::class create ValuetteMethods oo::class create Valuette { mixin ValuetteMethods Cascade variable val opt constructor {args} { lassign $args val opt } }; # oo::class create Valuette oo::class create Channelle { mixin ValuetteMethods Cascade variable val opt constructor {{aChannel {}} {autoFlush {1}}} { set val [expr {$aChannel ne {} ? $aChannel : "stdout"}] set opt $autoFlush } method out {{blob {}}} { puts -nonewline $val $blob if {$opt} { my flush } } method flush {} { flush $val } method cr {} { my out \n } method chan {args} { my val {*}$args } method af {args} { my opt {*}$args } }; # oo::class create Channelle oo::class create Numberre { mixin ValuetteMethods Cascade variable val opt constructor {{aNumber {0}} {hex {0}}} { set val $aNumber set opt $hex } foreach op [list + - * /] { method n$op {args} [format \ {set val [::tcl::mathop::%s $val {*}$args]} $op \ ]} method n== {num} { expr {$val == $num} } method n= {args} { format [expr {$opt ? "%x" : "%d"}] [my val {*}$args] } method hex {args} { my opt {*}$args } }; # oo::class create Numberre oo::class create Stringette { mixin ValuetteMethods Cascade variable val opt constructor {{aString ""} {maxLen {10}}} { set val $aString set opt $maxLen } foreach op [list upper lower title] \ mtd [list upr lwr ttl] { method $mtd {args} [format \ {set val [string to%s $val]} $op] } method rev {} { my val [string reverse [my val]] } method s> {args} { my s= [string cat [my val] [join $args ""]] } method s< {args} { my s= [string cat [join $args ""] [my val]] } method s== {str} { expr {[my val] eq $str} } method s= {args} { my val {*}$args my val [string range [my val] 0 [my maxLen]-1] } method maxLen {args} { my opt {*}$args } }; # oo::class create Numberre if 1 { Valuette create val puts [val cascade { val 123 ` val text}] # result: text puts "" Numberre create num puts [list [num cascade { n= 2 ` n* 2 3 ` n- 5 `? n== 3 ` n= -1 }] [num n=]] # result: {0 7} puts "" Channelle create chn chn cascade { out "Hello " `out World `cr `af 0 `out "Today is" `out " a" `flush `out " new Day" `af 1 `out ! `cr } # result: output presumably puts "" Stringette create str Too 15 puts [format "%s\n%s\n%s\n%s" [str cascade { rev ` s< "toH " ` rev ` s> " To" ` rev ` s< "ooH " ` rev ` s> t12345 }] [str rev] [str cascade { s= [regsub -all {\s} [str s=] {}] ` upr }] \ [str cascade { rev ` lwr}]] # result: ? puts "" chn cascade { af 1 ` out "Num: " ` out [num cascade { n* 123 < hex 1 < n+ 2 < n= } <] ` cr ` ign [val val C] ` cr ` out [str cascade { maxLen 20 ~ s= [string range [str s=] 0 end-6] ~ s= [regsub {(oo)} [str s=] {\1 }] ~ s< "It's " ~ s> ": " [num cascade { hex 0 ' n= } '] ~ s> [val val] ! } ~] ` cr } # It's a bit warm today ... }; # if 0/1 # EOF if 0 { $ tclsh cascade.tcl text 0 7 Hello World Today is a new Day! Too Hot To Hoot tooH oT toH ooT TOOHOTTOHOOT toohottohoot Num: 35f It's too hot: 863C! }