# ---------------------------------------------------------------- # The Tcl/Tk typewriter that includes an entry field for a user # to input a message. # # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # ---------------------------------------------------------------- proc go { message } { global index letters var # ---------------------------------------------------------------- # Trim original string of newline characters # ---------------------------------------------------------------- set original $message set original [string trimright $original] if {![regexp -nocase {[a-z]} [string index $original 0]]} { set original [string trimleft $original] } # ---------------------------------------------------------------- # Create list of letters # ---------------------------------------------------------------- set letter_list [split $original {}] set index 0 foreach ltr $letter_list { set letters($index) $ltr incr index } set list_length [llength $letter_list] # ---------------------------------------------------------------- # Set index to 0 # ---------------------------------------------------------------- set index 0 # ---------------------------------------------------------------- # Delete any text in text widget # ---------------------------------------------------------------- .text2 config -state normal .text2 delete 1.0 end .text2 config -state disabled # ---------------------------------------------------------------- # Call typewriter procedure # ---------------------------------------------------------------- typewriter .text2 50 $list_length # ---------------------------------------------------------------- # Delete text in entry field # ---------------------------------------------------------------- .text1 delete 1.0 end } proc typewriter {t d e} { global index letters # ---------------------------------------------------------------- # Place each letter in text field until end of message is reached # ---------------------------------------------------------------- if {$index < $e} { set message $letters($index) $t configure -state normal $t insert end $message $t configure -state disabled incr index after $d [list typewriter $t $d $e] } } # ---------------------------------------------------------------- # Create label and text widgets. Focus on entry field # ---------------------------------------------------------------- label .l1 -text "Enter your message and press return" \ -background white -anchor nw pack .l1 -side top text .text1 -height 1 -width 50 -bg white -wrap word pack .text1 -side top focus .text1 text .text2 -relief ridge -bg white -wrap word -state disabled \ -width 50 -height 4 pack .text2 -side top # ---------------------------------------------------------------- # Bind return key to text field. # ---------------------------------------------------------------- bind .text1 {go [.text1 get 1.0 end]}