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!
}