if { [info commands lassign] == "" } {
      proc lassign {L args} {
        uplevel 1 [list foreach $args [linsert $L end {}] break]
        lrange $L [llength $args] end
      }
    }
    
    interp alias {} nosubst {} subst -nobackslashes -nocommands -novariables
    
    proc template {name vars body} {
        set outvar [lindex $vars 0]
        lset vars 0 ${outvar}_var
        proc $name $vars [concat upvar 1 \$${outvar}_var $outvar \; [genrender $body $outvar]]
    }
    
    proc render {args} { uplevel 1 [eval {genrender} $args] }
    
    proc genrender {template {var OUT} {sub subst}} {
      set a "append $var \[$sub {"
      set b "}]\n\\1\n"
      set c [regsub -all -line {$\s*%\s(.*)} $template $b$a ]
      return $a$c\}\]
    }
    
    set v 3
    set mjd "Mark J. Dominus"
    set mjdweb "http://perl.plover.com/"
    set L [split "ABCD" ""]
    
    template example {OUTPUT v L} {
    % global env
    You can access variables: $v
    or environment variables: $env(HOME)
    
    You can call functions and evaluate code inline.
    The list [join $L ", "] has [llength $L] elements.
        [string repeat = [llength $L]]
        [join $L ""]
        [string repeat = [llength $L]]
    
    Loop
    % for {set i 0} { $i < [llength $L] } {incr i} {
        elem  L\[$i\] = [lindex $L $i]
    % }
    
    Append to output
    
    % for {set i 0} { $i < [llength $L] } {incr i} {
    %   append OUTPUT "  L\[$i\] = " ' [lindex $L $i] '
    % }
    % global mjd mjdweb
    
    This example is from $mjd at ${mjdweb}
    
    % set len [llength $L]
    The Lord High Chamberlain has gotten $len things for me this year.
    % set diff [expr { $len - 5 }]
    % set more "more"
    % if { $diff == 0 } {
    %   set more "no"
    % } elseif { $diff < 0 } {
    %   set diff [expr {-$diff}]
    %   set more "fewer"
    % }
    That is $diff $more than he gave me last year.
    }
    
    set OUT "For example"
    puts [example OUT $v $L]
    
    
    array set structs {
        a long
        c float
    }
    
    template render_struct {out n t} {
        struct $n {
            struct $n *next;
            $t data;
        };
    }
    
    foreach {n t} [array get structs] {
        render_struct output $n $t
    }
    puts $output

    For example
    You can access variables: 3
    or environment variables: /home/pshook
    
    You can call functions and evaluate code inline.
    The list A, B, C, D has 4 elements.
        ====
        ABCD
        ====
    
    Loop
        elem  L[0] = A
        elem  L[1] = B
        elem  L[2] = C
        elem  L[3] = D
    
    Append to output  L[0] = 'A'  L[1] = 'B'  L[2] = 'C'  L[3] = 'D'
    
    This example is from Mark J. Dominus at http://perl.plover.com/
    The Lord High Chamberlain has gotten 4 things for me this year.
    That is 1 fewer than he gave me last year.
    

    proc class {classname} {
    
        set template {
    
            global @[email protected]
            set @[email protected] 0
    
            proc @classname@_new {args} {
                global @[email protected]
                set self @classname@.[incr @[email protected]]
                # puts "@classname@_new $self"
                if [llength $args] { eval @classname@_set $self $args }
                return $self
            }
    
            proc @classname@_set {self args} {
                upvar #0 $self members
                # puts [info level 0]
                if { [string trimright $self .0123456789] != "@classname@" } {
                    error "invalid self: [info level 0]"
                }
                array set members $args
            }
    
            proc @classname@_get {self name} {
                upvar #0 $self members
                # puts [info level 0]
                if { [string trimright $self .0123456789] != "@classname@" } {
                    error "invalid self: [info level 0]"
                }
                if [catch { set val $members($name) }] {
                    error "no such member: [info level 0]"
                }
                return $val
            }
        }
    
        regsub -all @classname@ $template $classname template
    
        eval $template
    }
    
    class apple
    proc apple_byte {self} {
        puts "Taking a byte from apple $self"
        apple_set $self -size [expr [apple_get $self -size] - 1]
        if { [apple_get $self -size] <= 0 } {
            puts "Apple $self now completely eaten!"
        }
    }
    
    class fridge
    proc fridge_open {self} {
        if { [fridge_get $self -state] == "open" } {
            puts "Fridge $self already open."
        } else {
            puts "Opening fridge $self..."
            fridge_set $self -state "open"
        }
    }
    
    proc fridge_close {self} {
        if { [fridge_get $self -state] == "closed" } {
             puts "Fridge $self already closed."
        } else {
             puts "Closing fridge $self..."
             fridge_set $self -state "closed"
        }
    }
    
    set a1 [apple_new -size 3]
    set a2 [apple_new -color yellow -size 3]
    
    foreach i {1 2 3} {
        apple_byte $a1
        apple_byte $a2
    }
    
    set f1 [fridge_new -state open]
    fridge_close $f1
    fridge_close $f1
    fridge_open  $f1
    fridge_open  $f1
    fridge_close $f1
    
    proc fridge_paint {self color} {
        puts "Painting fridge $self $color ..."
        fridge_set $self -color $color
    }
    
    catch { puts "$f1 is [fridge_get $f1 -color]" } msg
    puts $msg
    fridge_paint $f1 green
    puts "The fridge $f1 is [fridge_get $f1 -color]"
    fridge_open  $f1
    fridge_paint $f1 blue
    puts "The fridge $f1 is [fridge_get $f1 -color]"
    fridge_close $f1