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

package require Thread
package require Tk

variable tick 0
pack [label .l -textvariable tick]

variable entry {}
pack [entry .e -textvariable entry]
bind .e <Return> StartTask

variable sent Sent:
pack [label .s -textvariable sent]

variable received Received:
pack [label .r -textvariable received]

proc every {ms cmd} {
    uplevel #0 $cmd
    after $ms [info level 0]
}
every 500 {incr tick}

variable tid [thread::create {
    proc blockSeconds {seconds count} {
        after [expr {1000*$seconds}]
        return [list $count $seconds]
    }
    thread::wait
}]

variable count 0
variable done {}
proc StartTask {} {
    variable entry
    variable count
    variable tid
    if {![string is integer -strict $entry]} {
        set entry {}
        return
    }
    thread::send -async $tid [list blockSeconds $entry [incr count]] ::done
    variable sent "Sent: task $count ($entry seconds) sent"
    set entry {}
}

trace add variable done write Receive
proc Receive {args} {
    variable done
    lassign $done count seconds
    variable received "Received: task $count ($seconds seconds) complete"
}