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.
71 lines
1.7 KiB
71 lines
1.7 KiB
|
|
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 |
|
|
|
|