Posted to tcl by dgp at Thu Apr 04 18:06:04 GMT 2013view raw

  1. package require Thread
  2. package require Tk
  3.  
  4. variable tick 0
  5. pack [label .l -textvariable tick]
  6.  
  7. variable entry {}
  8. pack [entry .e -textvariable entry]
  9. bind .e <Return> StartTask
  10.  
  11. variable sent Sent:
  12. pack [label .s -textvariable sent]
  13.  
  14. variable received Received:
  15. pack [label .r -textvariable received]
  16.  
  17. proc every {ms cmd} {
  18. uplevel #0 $cmd
  19. after $ms [info level 0]
  20. }
  21. every 500 {incr tick}
  22.  
  23. variable tid [thread::create {
  24. proc blockSeconds {seconds count} {
  25. after [expr {1000*$seconds}]
  26. return [list $count $seconds]
  27. }
  28. thread::wait
  29. }]
  30.  
  31. variable count 0
  32. variable done {}
  33. proc StartTask {} {
  34. variable entry
  35. variable count
  36. variable tid
  37. if {![string is integer -strict $entry]} {
  38. set entry {}
  39. return
  40. }
  41. thread::send -async $tid [list blockSeconds $entry [incr count]] ::done
  42. variable sent "Sent: task $count ($entry seconds) sent"
  43. set entry {}
  44. }
  45.  
  46. trace add variable done write Receive
  47. proc Receive {args} {
  48. variable done
  49. lassign $done count seconds
  50. variable received "Received: task $count ($seconds seconds) complete"
  51. }
  52.