punkshell/scriptlib/stdout_per_second.tcl

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 {1000 / $persec}]
set nl_every [expr {$persec * $newline_every_x_seconds}]

proc schedule {} {
    upvar ::counter c
    upvar ::maxcount maxcount
    if {$::forever_stdout_per_second} {
        if {$maxcount > 0 && $c >= $maxcount} {
            set ::forever_stdout_per_second 0
        } else {
            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 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 " "
        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 stderr "cancelling"
        }
    }
    if {[chan eof $chan]} {
        chan event $chan readable {}
    }
}} stdin]

schedule
vwait ::forever_stdout_per_second

vwait ::done_stdout_per_second