Posted to tcl by evilotto at Thu Dec 12 17:49:21 GMT 2013view pretty

package require struct
set q [struct::queue]

proc every {ms body} {
    after $ms [list after idle [info level 0]]
    if 1 $body
}

set X 0
set ct [clock millis]
set dt 0
every 100 {incr ::X}
every 100 {set ::dt [expr {[clock millis] - $::ct}]; set ::ct [clock millis]}
label .x -width 10 -textvariable X
label .y -width 10 -textvariable dt

pack .x .y

proc queue {body} {
    $::q put $body
    # after 0 [list after idle $body]
}

every 10 {
    if {[$::q size] > 0} {
        eval [$::q get]
    }
}

set bcount 0
proc busy {} {
    # puts [incr ::bcount]
    incr ::bcount
    after [expr {int(rand()*20)+50}]
}

every 200 {
    queue busy
    queue busy
    queue busy
    queue busy
    queue busy
    queue busy
}

after 5000 {puts "Busy $::bcount;  Tick: $::X"; exit}