# Coronet - a simple skeleton for coroutine networking
# CMcC and MS 2009-01-14

namespace eval Coronet {
    # if you are adventurous, you can redefine yield in terms of ::yield
    # proc yield {{retval ""}} {...}

    variable maxline 1024

    # provide access to variables defined in top level of coroutine
    proc corovars {args} {
        foreach n $args {lappend v $n $n}
        uplevel 1 [list upvar #1 {*}$v]
    }

    # terminate coroutine
    proc terminate {args} {
        return -level [info level] $args        ;# terminate consumer
    }

    # coroutine-enabled gets
    proc get {socket {reason ""}} {
        variable maxline
        set result [yield]
        set line ""
        while {[chan gets $socket line] == -1 && ![chan eof $socket]} {
            set result [yield]
            if {$maxline && [chan pending input $socket] > $maxline} {
                error "line length greater than $maxline"
            }
        }

        if {[chan eof $socket]} {
            terminate $reason        ;# check the socket for closure
        }

        # return the line
        return $line
    }

    # coroutine-enabled read
    proc read {socket size} {
        # read a chunk of $size bytes
        set chunk ""
        while {$size && ![chan eof $socket]} {
            set result [yield]
            set chunklet [chan read $socket $size]
            incr size [expr {-[string length $chunklet]}]
            append chunk $chunklet
        }
        
        if {[chan eof $socket]} {
            terminate entity        ;# check the socket for closure
        }
        
        # return the chunk
        return $chunk
    }

    proc do {args} {
        set x 1        ;# x is available via [corovars x]
        .... this is where your network code goes
    }

    proc init {name socket args} {
        set coro [coroutine $name ::Coronet::do {*}$args]
        fileevent $socket readable [list $coro INCOMING]
        return $coro
    }

    namespace export -clear *
    namespace ensemble create -subcommands {}
}

proc cgets {chan args} {
    if {[llength $args] == 1} {
        upvar 1 [lindex $args 0] line
    } elseif {[llength $args] > 1} {
        return -code error "wrong \# args, should be \"[lindex [info level 0] 0] channel ?variable?\""
    }
    while {1} {
        set blocking [fconfigure $chan -blocking]
        fconfigure $chan -blocking 0
        set status [catch {gets $chan line} result opts]
        if {$status} {
            fconfigure $chan -blocking $blocking
            return -code $status -options $opts
        } elseif {[fblocked $chan]} {
            fileevent $chan readable [list [info coroutine]]
            yield
            fileevent $chan readable {}
        } else {
            fconfigure $chan -blocking $blocking
            if {[llength $args] == 1} {
                return $result
            } else {
                return $line
            }
        }
    }
}

coroutine foo apply {{} {
    while {[cgets stdin line] >= 0} {
        puts $line
    }
    set ::finished 1
}}

vwait finished