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