chan configure stdin -blocking 0 -buffering none
#puts stderr "stdinconf: [chan configure stdin]"
set RST \x1b\[0m
set C \x1b\[32m  ;#child colour green
set P \x1b\[33m  ;#parent colour yellow


proc usage {args} {
    puts stderr "rcvd : [info script] $args"
    puts stderr "usage:"
    puts stderr "       [info script] pump <persecond> <maxcount>"
    puts stderr "       [info script] parent"
    puts stderr "       [info script] child <delay_ms>"
    puts stderr \n
    puts stderr "e.g:"
    puts stderr "       >tclsh"
    puts stderr "       %chan configure stdin -blocking 0"
    puts stderr "       %tclsh [info script] pump 35 50 | tclsh [info script] parent"
    exit 0
}

proc read_child {chan} {
    if {![eof $chan]} {
        puts stdout [read $chan]
        flush stdout
    } else {
        set ::done 1
    }
}

proc pump_schedule {} {
    upvar ::counter c
    upvar ::maxcount maxcount
    if {$::forever_pump} {
        if {$maxcount > 0 && $c >= $maxcount} {
            set ::forever_pump 0
        } else {
            after idle [list after 0 ::pump_emit]
        }
        tailcall after $::ms ::pump_schedule
    } else {
        after idle [list ::pump_end]
    }
}
proc pump_emit {} {
    upvar ::counter c
    if {[catch {
        puts -nonewline stdout .[incr c]
    }]} {
        set ::forever_pump 0
    }
    flush stdout
}
proc pump_end {} {
    puts stderr "pump-done"
    flush stderr
    flush stdout
}

switch -- [lindex $::argv 0] {
    pump {
        if {$::argc != 3} {usage {*}$::argv}
        set persec   [lindex $::argv 1]
        set maxcount [lindex $::argv 2]
        if {$persec > 1000} {
            puts stderr "WARNING: (>1000) sub millisecond scheduling not available - will go full speed"
            flush stderr
            after 500
        }
        chan configure stdout -blocking 1 -buffering none
        set counter -1
        set ms [expr {1000 / $persec}]
        set ::forever_pump 1

        pump_schedule
        vwait ::forever_pump
    }
    parent {
        if {$::argc != 1} {usage {*}$::argv}
        puts stderr "${::P}parent$RST"
        after 250
        set parent_chunk1 [read stdin 8]
        #set rdout [open |[concat tclsh [info script] child 150 2>@stdout <@stdin] RDONLY]
        set rdout [open |[concat tclsh [info script] child 150  2>@stdout <@stdin] RDONLY]
        chan conf $rdout -blocking 0 -buffersize 1
        chan event $rdout readable [list ::read_child $rdout]

        puts -nonewline stderr $::P$parent_chunk1$::RST
        flush stderr

        after 10000 {set ::done 1}
        vwait ::done
        puts stdout parent-tail-read
        while {![eof stdin]} {
            puts -nonewline stderr [read stdin]
            flush stderr
        }
        puts stdout \n${::P}parent-done$::RST
        flush stdout
    }
    child {
        if {$::argc != 2} {usage $::argv}
        set delay_ms [lindex $::argv 1]
        puts stdout "\n${::C}child$::RST"
        after $delay_ms 
        puts stdout ${::C}[read stdin 16]$::RST
        #puts stderr ${::C}[read stdin]$::RST
        puts stdout "child-done"
        flush stderr
        exit 0
    }
    default {usage $::argv}
}
exit 0