You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
115 lines
3.2 KiB
115 lines
3.2 KiB
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 |
|
|
|
|