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.
77 lines
1.7 KiB
77 lines
1.7 KiB
|
|
if {$::argc >= 1} { |
|
set persec [lindex $::argv 0] |
|
} else { |
|
set persec 1 |
|
} |
|
if {$::argc == 2} { |
|
set what [lindex $::argv 1] |
|
} else { |
|
set what "." |
|
} |
|
|
|
if {$persec > 1000} { |
|
puts stderr "WARNING: (>1000) sub millisecond scheduling not available - will go full speed" |
|
flush stderr |
|
after 500 |
|
} |
|
#--- confg --- |
|
set newline_every_x_seconds 5 |
|
#--- |
|
chan configure stdout -blocking 1 -buffering none |
|
set counter 0 |
|
set ms [expr {1000 / $persec}] |
|
set nl_every [expr {$persec * $newline_every_x_seconds}] |
|
|
|
proc schedule {} { |
|
if {$::forever_stdout_per_second} { |
|
after idle [list after 0 ::emit] |
|
tailcall after $::ms ::schedule |
|
} else { |
|
after idle [list ::the_end] |
|
} |
|
} |
|
|
|
set ::forever_stdout_per_second 1 |
|
|
|
proc the_end {} { |
|
puts "-done-" |
|
flush stdout |
|
set ::done_stdout_per_second 1 |
|
} |
|
|
|
proc emit {} { |
|
upvar ::counter c |
|
if {($c > 1) && (($c % $::nl_every) == 0)} { |
|
puts -nonewline stdout " " |
|
flush stdout |
|
puts stderr $c |
|
flush stderr |
|
} else { |
|
puts -nonewline stdout $::what |
|
} |
|
#flush stdout |
|
incr c |
|
} |
|
chan configure stdin -blocking 0 -buffering none |
|
chan event stdin readable [list apply {{chan} { |
|
set chunk [chan read $chan] |
|
if {[string length $chunk]} { |
|
if {[string match "*q*" [string tolower $chunk]]} { |
|
set ::forever_stdout_per_second 0 |
|
chan event $chan readable {} |
|
puts stdout "cancelling" |
|
} |
|
} |
|
if {[chan eof $chan]} { |
|
chan event $chan readable {} |
|
} |
|
}} stdin] |
|
|
|
schedule |
|
vwait ::forever_stdout_per_second |
|
|
|
vwait ::done_stdout_per_second |
|
|
|
|
|
|
|
|