Source code:
# ---------------------------------------------------------------- # A text slider demo using the text widget. # # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # ---------------------------------------------------------------- # ---------------------------------------------------------------- # Shows a character at a position on line 1, and schedules it for # deletion in 5 milliseconds. # ---------------------------------------------------------------- proc show_and_delete {char currentPosition} { .t insert 1.$currentPosition $char tag1 after 5 {.t delete tag1.first} } # ---------------------------------------------------------------- # Schedules characters to be displayed at given positions at # times in the future. Schedules the character to be displayed in # it's final location after the sliding is complete. Deletes the # space replaced by this character. # ---------------------------------------------------------------- proc slide {char position} { set width [lindex [.t configure -width] 4] incr width -2 set time 1 for {set i $width} {$i > $position} {incr i -1} { after $time [list show_and_delete $char $i] incr time 10; } after $time [list .t insert 1.$position $char] incr position; after $time [list .t delete 1.$position] } # ---------------------------------------------------------------- # Creates the list of letters # ---------------------------------------------------------------- set original "Hello. I am the Tcl/Tk slider." set letter_list [split $original {} ] set list_length [llength $letter_list] set textwidth 40 # ---------------------------------------------------------------- # Creates the text widget # ---------------------------------------------------------------- text .t -relief ridge -bd 2 -wrap word -bg white -height 5 \ -width $textwidth pack .t -side left # ---------------------------------------------------------------- # Fill line with spaces. # ---------------------------------------------------------------- for {set i 0} {$i < [expr $textwidth-2]} {incr i} {.t insert end " "} set position 0; set starttime 1; # ---------------------------------------------------------------- # Slides each letter # ---------------------------------------------------------------- foreach letter $letter_list { set delay [expr (($textwidth - $position) *5) + 200] if {$letter != " "} { after $starttime [list slide $letter $position] incr starttime $delay } incr position; }