if {$::argc == 1} { set persec $::argv } else { set persec 1 } 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_ansi_count_per_second} { after idle [list after 0 ::emit] tailcall after $::ms ::schedule } else { after idle [list ::the_end] } } set ::forever_ansi_count_per_second 1 proc the_end {} { puts stderr "-done-" flush stderr flush stdout set ::done_ansi_count_per_second 1 rename ::emit "" rename ::schedule "" rename ::the_end "" } proc emit {} { upvar ::counter c puts -nonewline "\x1b\[1000D$c" #if {($c > 1) && (($c % $::nl_every) == 0)} { # puts stdout $c # flush stdout #} else { # puts -nonewline "\x1b\[1000D$c" #} #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_ansi_count_per_second 0 chan event $chan readable {} puts stderr "cancelling" } } if {[chan eof $chan]} { chan event $chan readable {} } }} stdin] schedule vwait ::forever_ansi_count_per_second vwait ::done_ansi_count_per_second