Tcl/Tk slider

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;
  }