Purpose: This page attempts to provide a simple working example of an event-driven program. (also see Keep a GUI alive during a long calculation)
KBK:
Many times, users ask how to keep a Tk user interface "live" while some long-running calculation is being performed, or some I/O is proceeding in the background -- in general, how to keep a Tk application running while it's waiting for something. Often people, point to the update command in reply. The update command is not the Tcl Way.
Let's try writing a script that counts a label down from 10 to 1. Here's a version of the program that uses update:
# Create a simple GUI to monitor the clock
label .counter -font {Helvetica 72} -width 3 -textvariable count
grid .counter -padx 100 -pady 100
# Run the countdown
for { set count 10 } { $count >= 0 } { incr count -1 } {
# Make sure that the GUI stays up to date
update
# Wait one second between time ticks
after 1000
}
exitIf you run this program, you'll see that it displays numbers counting down from 10 to 0 and then exits. The problem, though, is that it isn't really live. During the 'after', it isn't interacting with the user. Updating your UI this way is a really bad idea.
Consider, rather, structuring your application like the program below. Like the one above, it counts down from 10 to 0 and then exits.
To understand it, it's best to look first at the main program (at the bottom of the file, below the countdown procedure. It does two things: it initiates the countdown by calling countdown for the first time, and it creates a trivial user interface, consisting of just a label widget, to display the result.
Everything interesting happens within the countdown procedure. On the first trip through, it finds that the count variable does not exist, and sets it to 10. It then executes the
after 1000 countdown
statement, which causes the event loop to call countdown again one second later.
At this point, the GUI gets created; the label widget finds that the value of its text variable is 10, and displays it.
One second later, countdown enters the second time. This time, it finds that count exists, and decrements it from 10 to 9. The magic of Tk (Tcl variable traces, if you must know) causes the label widget to update automatically. The countdown procedure then executes that after statement again, so that it will wake up one second later.
[ ... ]
On its final trip, countdown enters with the value of count at 0. It decrements it to -1, discovers that it has gone negative, and unceremoniously exits.
# Chain of events that manages the countdown
proc countdown {} {
variable count
# The first time through, 'count' is 10; thereafter, it
# decrements on each trip
if { ![info exists count] } {
set count 10
} else {
incr count -1
}
# When the count goes negative, exit
if { $count < 0 } {
exit
}
# Schedule the next tick of the clock
after 1000 countdown
return
}
# Start the clock
countdown
# Create a simple GUI to monitor the clock
label .counter -font {Helvetica 72} -width 3 -textvariable count
grid .counter -padx 100 -pady 100The more concise version of the countdown procedure can be written as:
proc countdown2 {{cnt 10}} {
set ::count $cnt
if {$cnt < 0} exit
incr cnt -1
after 1000 [list countdown2 $cnt]
}Exercises
NEM 24June2004 - as a related item, here is a little toy proc for making a foreach loop run asynchronously. Needs work to be really useful, and could benefit from some form of lambda, but somebody might find it useful as a version of the pattern used above:
proc async-foreach {var list body} {
proc async-body [list $var args] [string map [list %BODY $body] {
%BODY
if {[llength $args] > 0} { after idle [linsert $args 0 async-body] }
}]
after idle [linsert $list 0 async-body]
}And a usage example:
async-foreach item {1 2 3 4 5} { puts "Item = $item" }
vwait forever
# Produces:
# item = 1
# item = 2
# item = 3
# item = 4
# item = 5The above implementation has the following limitations:
Extensions are possible, but that needs some work
Lars H: It is perfectly possible to make do without lambdas and unique-name schemes.
proc async-foreach {vars list body {final ""}} {
if {[llength $vars] && [llength $list]} then {
foreach $vars $list {break}
set list [lrange $list [llength $vars] end]
if 1 then $body
after idle [list async-foreach $vars $list $body $final]
} else $final
}(The [if 1 then $body] rather than [eval $body] here is to have $body byte-compiled.) This form adds a second body ($final) which is evaluated after the last iteration. It also supports multiple loop variables. Example:
% async-foreach {item item2} {1 2 3 4 5} { puts "Items = ($item,$item2)" } {puts "That's all, folks!"}
Items = (1,2)
after#28
% Items = (3,4)
Items = (5,)
That's all, folks!Note the slight asynchronicity that the return value from the command (after#28, from the after command) and the following prompt are printed by the command loop between the first and second iteration of the asynch-foreach.
One problem with the above procedure is that you mustn't use the variable names vars, list, body, or final in the body. In a production environment, they should rather be given names like __vars, __list, __body, and __final to avoid unintended overwritings.
NEM Nice improvement. The reason I suggested lambda was precisely to avoid having to have specially named variables. For instance, see the absurd lengths I go to to acheive this at More functional programming. I like the "final" clause - could be useful. Here's another version which handles (I think) all the forms of foreach, allows for cleanup, and allows you to cancel a loop at any time:
namespace eval async { variable id 0; variable data }
# async::foreach --
#
# Usage: async::foreach varlist list ?varlist list...? ?-interval ms|idle? ?-finally script? body
proc async::foreach {varlist list args} {
variable id; variable data
set usage "async::foreach varlist list ?varlist list...? ?-interval ms|idle? ?-finally script? body"
if {[llength $args] < 1 || ([llength $args] % 2) != 1} {
return -code error "wrong # args: should be \"$usage\""
}
set curid [incr id]
set body [lindex $args end]
set data($curid,final) ""
set data($curid,interval) idle
set vars $varlist
set data($curid,lengths) [list [llength $varlist]]
set lists [list $list]
::foreach {key value} [lrange $args 0 end-1] {
if {$key eq "-interval"} {
set data($curid,interval) $value
} elseif {$key eq "-finally"} {
set data($curid,final) $value
} else {
eval lappend vars $key
lappend data($curid,lengths) [llength $key]
lappend lists $value
}
}
# Create a proc for this body
proc body$curid $vars $body
set data($curid,event) [after $data($curid,interval) [list ::async::do $curid $lists]]
return $curid
}
# Proc to actually run the body of the foreach
proc async::do {id lists} {
variable data
set call [list ::async::body$id]; set remainder [list]
for {set i 0} {$i < [llength $data($id,lengths)]} {incr i} {
set clist [lindex $lists $i]; set clen [lindex $data($id,lengths) $i]
eval lappend call [lrange $clist 0 [expr {$clen -1}]]
lappend remainder [lrange $clist $clen end]
}
if {[llength $call] == 1} {
# Finished
cancel $id
} else {
# Evaluate
uplevel 1 $call
set data($id,event) [after $data($id,interval) [list ::async::do $id $remainder]]
}
}
# Cancel a running loop
proc async::cancel {id} {
variable data
after cancel $data($id,event)
set final $data($id,final)
::foreach key [array names data $id,*] { unset data($key) }
rename ::async::body$id {}
# Run -finally script, if any
uplevel 1 $final
}And a usage example:
set id [async::foreach name {Neil Pete Jon} age {23 42 12} -interval 1000 -finally { puts "Done!" } {
puts "Name = $name Age = $age"
}]
after 2100 [list ::async::cancel $id]
vwait async::data($id,final)
# Produces:
# Name = Neil Age = 23
# Name = Pete Age = 42
# Done!
schlenk How about moving this async foreach into the control module of tcllib? Could help in the effort to make POP3/IMAP4/NNTP protocols in tcllib capable of async operation.
NEM OK. I've just spotted a bug though (doesn't handle the foreach a {1 2} b {1} ... case). I'll fix it up and get someone to add it in. async versions of for and while would probably be good too.
Category Example | Category Tutorial | Category Control Structure