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

package provide worker_thread 0.1

package require Thread

proc t {args} { puts [clock microseconds]:\ [string range [info level -1]:\ [uplevel 1 [list subst $args]] 0 100]}
proc t args {}

::oo::class create WorkerThread {

    variable result
    variable cmdprefix
    variable worker

    constructor {args} {
        set result {}
        set cmdprefix $args
        set worker [thread::create {
            
            proc t {args} { puts [clock microseconds]:\ [string range [info level -1]:\ [uplevel 1 [list subst $args]] 0 100]}
            proc t args {}
            
            package require Thread
            
            proc poll {} {
                if {[info commands coro] ne {}} {
                    return [coro]
                } else {
                    return {}
                }
            }
            
            proc task {args} {
                if {[info commands coro] ne {}} {
                    rename coro {}
                }
                coroutine coro {*}$args
            }
            
            thread::wait
        }]
#        if {$args ne {}} {
#            thread::send $worker [concat $args]
#        }
        trace add variable [namespace current]::result write [list [self] callback]
    }
    
    method eval {args} {
        thread::send -async $worker [concat {*}$args]
    }
    
    method send {args} {
        thread::send -async $worker [concat task $args] [namespace current]::result
    }
    
    method callback {args} {
        if {$result eq {}} {
            #after 500 [list thread::send -async $worker poll [namespace current]::result]  
        } else {
            uplevel #0 $cmdprefix $result
            after 0 [list thread::send -async $worker poll [namespace current]::result]     
        }
    }
}