Source code:
# ---------------------------------------------------------------- # The Tcl/Tk typewriter # # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # ---------------------------------------------------------------- proc typewriter {w time length} { # ---------------------------------------------------------------- # Declare the index and letters array as global # ---------------------------------------------------------------- global index letters # ---------------------------------------------------------------- # Scan the text in the text box # ---------------------------------------------------------------- scan [$w index 1.end] %d.%d line len # ---------------------------------------------------------------- # If the length of the text is shorter than the specified # length, then continue # ---------------------------------------------------------------- if { $len < $length} { # ---------------------------------------------------------------- # Set let to the element of the array # ---------------------------------------------------------------- set let $letters($index) # ---------------------------------------------------------------- # Insert the letter # ---------------------------------------------------------------- $w configure -state normal $w insert end $let $w configure -state disabled # ---------------------------------------------------------------- # Increase the index (array variable) # ---------------------------------------------------------------- incr index # ---------------------------------------------------------------- # After a time period, call the typewriter procedure again, # using the same values # ---------------------------------------------------------------- after $time [list typewriter $w $time $length] # ---------------------------------------------------------------- # Close the if loop and procedure # ---------------------------------------------------------------- } } # ---------------------------------------------------------------- # Create the list of letters # ---------------------------------------------------------------- set original "Hello. I am the Tcl/Tk typewriter." set letter_list [split $original {}] set index 0 foreach ltr $letter_list { set letters($index) $ltr incr index } # ---------------------------------------------------------------- # Create the text box # ---------------------------------------------------------------- text .t -relief ridge -bd 2 -wrap word -bg white -state disabled \ -height 5 -width 30 pack .t -side left # ---------------------------------------------------------------- # Create initial value and call the procedure # ---------------------------------------------------------------- set index 0 typewriter .t 50 [llength $letter_list] # ---------------------------------------------------------------- # Configuring text # ---------------------------------------------------------------- for { set i 16} { $i <=21} {incr i} { .t tag configure tag$i -foreground red }