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

  }

  exit
----
If 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 100
----
The 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'''
   1. How would you add '''Stop''' and '''Reset''' buttons to the GUI and interface them with the countdown?  (Hint: Look up '''after cancel''' in the Tcl manual.)
   1. Oh, by the way, did I tell you that I wanted the '''Stop''' button to be enabled only when the countdown is running, and the '''Reset''' button only when it's stopped?  Modify the program to keep track of its state.
   1. Develop a version of the program that handles several countdowns launched from the same script.  (Hint: Pass the path name of the label widget as a parameter to the '''countdown''' procedure.)
   1. How difficult would the first three exercises be in the version of the program that's based on the '''update''' command?
   1. If you want a countdown of several hours, rather than ten seconds, what are the problems with this program?  What might you do about them?

----
[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 = 5

The above implementation has the following limitations:

   * Only one loop can be active at any one time (hence the need for lambda or a unique-name scheme)
   * Only one variable and one list to iterate over

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]