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

  1. package require struct
  2. set q [struct::queue]
  3.  
  4. proc every {ms body} {
  5. after $ms [list after idle [info level 0]]
  6. if 1 $body
  7. }
  8.  
  9. set X 0
  10. set ct [clock millis]
  11. set dt 0
  12. every 100 {incr ::X}
  13. every 100 {set ::dt [expr {[clock millis] - $::ct}]; set ::ct [clock millis]}
  14. label .x -width 10 -textvariable X
  15. label .y -width 10 -textvariable dt
  16.  
  17. pack .x .y
  18.  
  19. proc queue {body} {
  20. $::q put $body
  21. # after 0 [list after idle $body]
  22. }
  23.  
  24. every 10 {
  25. if {[$::q size] > 0} {
  26. eval [$::q get]
  27. }
  28. }
  29.  
  30. set bcount 0
  31. proc busy {} {
  32. # puts [incr ::bcount]
  33. incr ::bcount
  34. after [expr {int(rand()*20)+50}]
  35. }
  36.  
  37. every 200 {
  38. queue busy
  39. queue busy
  40. queue busy
  41. queue busy
  42. queue busy
  43. queue busy
  44. }
  45.  
  46. after 5000 {puts "Busy $::bcount; Tick: $::X"; exit}