Tcl/Tk ticker tape

Source code:



#--------------------------------------------------------------
#  ticker.tcl
#
#  Freely modifiable/redistributable under the "Standard Tcl License"
#  See http://www.eolas.com/tcl/license.txt for details

set index 0
array set text_messages {
	0	"What a nice day! Get away from the computer!"
	1	"Use the Spynergy Weblet Developer to cut your development time by 90%"
	2	"Simply the fastest, easiest and most powerful way to develop interactive Web content"
	3	"Cross platform, secure and rapid application development"
}
proc doticker {t d f e} {
    global index text_messages

    scan [$t index 1.end] %d.%d line len
    if {$len < $e} {
	if {![info exists text_messages($index)]} {
	    set index 0
	}
	set message $text_messages($index)

	$t configure -state normal
	$t insert end "$f" fill
	$t insert end $message tag$index
	$t configure -state disabled

	incr index
    }
    $t configure -state normal
    $t delete 1.0
    $t configure -state disabled
    after $d [list doticker $t $d $f $e]
}
text .t -relief ridge -bd 2 -wrap none -bg white -state disabled -height 5
.t tag configure fill -foreground red
.t tag configure tag0 -font *-times-bold-r-normal-18-* -foreground blue1
.t tag configure tag1 -font *-times-medium-i-normal-18-* -foreground blue4
.t tag configure tag2 -font *-times-medium-r-normal-18-* -foreground RoyalBlue4
.t tag configure tag3 -underline true \
	-foreground SlateBlue3 -font *-times-medium-i-normal-18-*
pack .t
doticker .t 400 " ******* " 95