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.
 
 
 
 
 
 

139 lines
3.6 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 {$::argc == 3} {
set ::maxcount [lindex $::argv 2]
} else {
set ::maxcount 0
}
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 {round(1000 / $persec)}]
set nl_every [expr {round($persec * $newline_every_x_seconds)}]
proc schedule {} {
upvar ::counter c
upvar ::maxcount maxcount
upvar ::ms ms
if {$::forever_stdout_per_second} {
if {$maxcount > 0 && $c >= $maxcount} {
set ::forever_stdout_per_second 0
} else {
after idle [list after 0 ::emit]
}
if {$ms == 0} {
tailcall after idle ::schedule
} else {
tailcall after $::ms ::schedule
}
} else {
after 0 [list ::the_end]
}
}
set ::forever_stdout_per_second 1
proc the_end {} {
puts stderr "-done-"
flush stderr
flush stdout
set ::done_stdout_per_second 1
}
proc emit {} {
upvar ::counter c
if {($c > 1) && (($c % $::nl_every) == 0)} {
puts -nonewline stdout "$::what "
flush stdout
puts stderr $c
flush stderr
} else {
puts -nonewline stdout $::what
}
incr c
}
set original_config [chan configure stdin]
chan configure stdin -blocking 0 -buffering none
if {[catch {chan configure stdin -inputmode raw} errM]} {
package require punk::console
punk::console::enableRaw
}
variable ::cmdbuffer ""
chan event stdin readable [list apply {{chan} {
upvar ::cmdbuffer b
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 stderr "cancelling"
if {$::ms > 500} {
after 0 ::the_end
}
} else {
if {[catch {
package require punk::ansi
puts stderr [punk::ansi::a bold yellow][punk::ansi::ansistring VIEW -lf 1 -cr 1 -crlf 1 $chunk][punk::ansi::a]
} _err]} {
puts stderr $chunk
}
}
if {$chunk in [list "\r" "\n" "\r\n"]} {
if {[string is double -strict $b]} {
if {$b == 0} {
puts stderr "ms must be > 0"
set ::ms 1
}
set ::ms [expr {round(1000 / $b)}]
set ::nl_every [expr {round($b * $::newline_every_x_seconds)}]
puts stderr "ms: $::ms"
} else {
if {[string match "!*" $b]} {
set cmd [string range $b 1 end]
if {[catch {eval $cmd} result]} {
puts stderr "error: $result"
} else {
puts stderr "ok"
puts stderr $result
}
} else {
puts stderr "cmd: '$b' not understood - use 'q' to quit"
}
}
set b ""
} else {
append b $chunk
}
}
if {[chan eof $chan]} {
chan event $chan readable {}
}
}} stdin]
schedule
vwait ::forever_stdout_per_second
vwait ::done_stdout_per_second
catch {chan configure stdin {*}$originalconfig}