Coroutine RLE stream decoder example.

# An example of a coroutine based RLE decoder
# Reads data a character at a time. If the input is \xff then the next byte
# is the number of repetitions of the following byte.
# Each call to the coroutine will return 1 byte.

load /opt/tcl/site-lib/Memchan2.2.2/memchan222.dll
package require Memchan

namespace path ::tcl::unsupported
variable uid 0

# A factory procedure that returns a lambda-based coroutine to decode
# our RLE encoded channel. When the lambda exits, it will clean
# up the decoder procedure automatically.
# The proc returns the name of the created decoder, each call to this
# new command will return one character from the data stream or -1 when
# the stream has been emptied.
proc make-decompressor {channel} {
    variable uid
    set lambda [list {chan} {
        yield
        while {1} {
            set c [read $chan 1]
            if {[eof $chan]} {
                return -1
            }
            if {[scan $c %c] == 0xff} {
                set len [scan [read $chan 1] %c]
                set c [read $chan 1]
                while {$len} {
                    incr len -1
                    yield $c
                }
            } else {
                yield $c
            }
        }
    }]
    set name rle[incr uid]
    coroutine $name ::apply $lambda $channel
    return $name
}

# Create a channel with some sample RLE encoded data.
set mem [memchan]
puts -nonewline $mem "\x31\x32\x33\xff\x06\x34\x35"
seek $mem 0

# Create a coroutine reader that will return one char per call from the
# compressed channel data.
set getchar [make-decompressor $mem]

# Prove that the decoder exists as a command
puts "$getchar exists? [llength [info commands $getchar]]"

# Nice simple reader code...
set n 0
while {[set c [$getchar]] != -1} {
    puts "$n '$c'"
    incr n
}

close $mem

# Prove the decoder was automatically garbage collected.
puts "$getchar exists? [llength [info commands $getchar]]"