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