|
|
|
|
|
|
|
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
|
|
|
|
|