Posted to tcl by aspect at Wed May 14 11:20:23 GMT 2014view raw

  1. package provide worker_thread 0.1
  2.  
  3. package require Thread
  4.  
  5. proc t {args} { puts [clock microseconds]:\ [string range [info level -1]:\ [uplevel 1 [list subst $args]] 0 100]}
  6. proc t args {}
  7.  
  8. ::oo::class create WorkerThread {
  9.  
  10. variable result
  11. variable cmdprefix
  12. variable worker
  13.  
  14. constructor {args} {
  15. set result {}
  16. set cmdprefix $args
  17. set worker [thread::create {
  18.  
  19. proc t {args} { puts [clock microseconds]:\ [string range [info level -1]:\ [uplevel 1 [list subst $args]] 0 100]}
  20. proc t args {}
  21.  
  22. package require Thread
  23.  
  24. proc poll {} {
  25. if {[info commands coro] ne {}} {
  26. return [coro]
  27. } else {
  28. return {}
  29. }
  30. }
  31.  
  32. proc task {args} {
  33. if {[info commands coro] ne {}} {
  34. rename coro {}
  35. }
  36. coroutine coro {*}$args
  37. }
  38.  
  39. thread::wait
  40. }]
  41. # if {$args ne {}} {
  42. # thread::send $worker [concat $args]
  43. # }
  44. trace add variable [namespace current]::result write [list [self] callback]
  45. }
  46.  
  47. method eval {args} {
  48. thread::send -async $worker [concat {*}$args]
  49. }
  50.  
  51. method send {args} {
  52. thread::send -async $worker [concat task $args] [namespace current]::result
  53. }
  54.  
  55. method callback {args} {
  56. if {$result eq {}} {
  57. #after 500 [list thread::send -async $worker poll [namespace current]::result]
  58. } else {
  59. uplevel #0 $cmdprefix $result
  60. after 0 [list thread::send -async $worker poll [namespace current]::result]
  61. }
  62. }
  63. }