JM 2 Apr 2014 - This code is heavily based on
Rolling credits by
RSThis is a canvas with a scrolling single line text message.
console show
package require Tk
proc titleshow {w title} {
set -fill black
set -font {Helvetica 16}
set x [winfo width $w]
set y 20
foreach line [split $title \n] {
set line "[string trim $line] "
if [string match -* $line] {
eval [linsert $line 0 set]
} else {
$w create text $x $y -text $line -fill ${-fill} -font ${-font} -tag title -anchor w
set index [lindex [.c bbox all] 2]
set x $index
}
}
every 10 "if !\[titleshow'roll $w title -2\] return"
}
proc titleshow'roll {w tag dy} {
$w move $tag $dy 0;# (1)
foreach i [$w find withtag $tag] {
set y1 [lindex [$w bbox $i] end]
if {$y1<0} {$w delete $i}
}
llength [$w find withtag $tag]
}
proc every {ms body} {eval $body; after $ms [info level 0]}
# That's all the code, here's a testing demo. Lines starting with - set parameters, the others are displayed:
pack [canvas .c -bg gray -width 1000]
tkwait visibility .c
titleshow .c {
-fill white
-font {Helvetica 18 italic}
The 12th European Tcl/Tk User Meeting (aka EuroTcl 2014) takes place July 12-13 2014 in Munich, Germany.
-font {Helvetica 24 bold}
-fill yellow
The twenty-first Annual Tcl/Tk Conference (aka Tcl2014) takes place Nov 10-14 2014 in Portland, Oregon, USA.
-font {Helvetica 18}
-fill white
Tcl/Tk 8.6.1 Released!
-font {Helvetica 24}
-fill yellow
Please add your ideas to our GSoC Idea Page.
-font {Helvetica 18}
Our main page is the Tcl/Tk GSoC Page
-font {Helvetica 10}
Richard Suchenwirth
}