Tcl/Tk Typewriter

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
	}