1# anilabel.tcl --
2#
3# This demonstration script creates a toplevel window containing
4# several animated label widgets.
5#
6# RCS: @(#) $Id$
7
8if {![info exists widgetDemo]} {
9    error "This script should be run from the \"widget\" demo."
10}
11
12package require Tk
13
14set w .anilabel
15catch {destroy $w}
16toplevel $w
17wm title $w "Animated Label Demonstration"
18wm iconname $w "anilabel"
19positionWindow $w
20
21label $w.msg -font $font -wraplength 4i -justify left -text "Four animated labels are displayed below; each of the labels on the left is animated by making the text message inside it appear to scroll, and the label on the right is animated by animating the image that it displays."
22pack $w.msg -side top
23
24## See Code / Dismiss buttons
25set btns [addSeeDismiss $w.buttons $w]
26pack $btns -side bottom -fill x
27
28# Ensure that this this is an array
29array set animationCallbacks {}
30
31## This callback is the core of how to do animation in Tcl/Tk; all
32## animations work in basically the same way, with a procedure that
33## uses the [after] command to reschedule itself at some point in the
34## future. Of course, the details of how to update the state will vary
35## according to what is being animated.
36proc RotateLabelText {w interval} {
37    global animationCallbacks
38
39    # Schedule the calling of this procedure again in the future
40    set animationCallbacks($w) [after $interval RotateLabelText $w $interval]
41
42    # We do marquee-like scrolling text by chopping characters off the
43    # front of the text and sticking them on the end.
44    set text [$w cget -text]
45    set newText [string range $text 1 end][string index $text 0]
46    $w configure -text $newText
47}
48
49## A helper procedure to start the animation happening.
50proc animateLabelText {w text interval} {
51    global animationCallbacks
52
53    # Install the text into the widget
54    $w configure -text $text
55
56    # Schedule the start of the animation loop
57    set animationCallbacks($w) [after $interval RotateLabelText $w $interval]
58
59    # Make sure that the animation stops and is cleaned up after itself
60    # when the animated label is destroyed.  Note that at this point we
61    # cannot manipulate the widget itself, as that has already died.
62    bind $w <Destroy> {
63	after cancel $animationCallbacks(%W)
64	unset animationCallbacks(%W)
65    }
66}
67
68## Next, a similar pair of procedures to animate a GIF loaded into a
69## photo image.
70proc SelectNextImageFrame {w interval} {
71    global animationCallbacks
72    set animationCallbacks($w) \
73	    [after $interval SelectNextImageFrame $w $interval]
74    set image [$w cget -image]
75
76    # The easy way to animate a GIF!
77    set idx -1
78    scan [$image cget -format] "GIF -index %d" idx
79    if {[catch {
80	# Note that we get an error if the index is out of range
81	$image configure -format "GIF -index [incr idx]"
82    }]} then {
83	$image configure -format "GIF -index 0"
84    }
85}
86proc animateLabelImage {w imageData interval} {
87    global animationCallbacks
88
89    # Create a multi-frame GIF from base-64-encoded data
90    set image [image create photo -format GIF -data $imageData]
91
92    # Install the image into the widget
93    $w configure -image $image
94
95    # Schedule the start of the animation loop
96    set animationCallbacks($w) \
97	    [after $interval SelectNextImageFrame $w $interval]
98
99    # Make sure that the animation stops and is cleaned up after itself
100    # when the animated label is destroyed.  Note that at this point we
101    # cannot manipulate the widget itself, as that has already died.
102    # Also note that this script is in double-quotes; this is always OK
103    # because image names are chosen automatically to be simple words.
104    bind $w <Destroy> "
105	after cancel \$animationCallbacks(%W)
106	unset animationCallbacks(%W)
107	rename $image {}
108    "
109}
110
111# Make some widgets to contain the animations
112labelframe $w.left -text "Scrolling Texts"
113labelframe $w.right -text "GIF Image"
114pack $w.left $w.right -side left -padx 10 -pady 10 -expand yes
115
116# This method of scrolling text looks far better with a fixed-width font
117label $w.left.l1 -bd 4 -relief ridge -font fixedFont
118label $w.left.l2 -bd 4 -relief groove -font fixedFont
119label $w.left.l3 -bd 4 -relief flat -font fixedFont -width 18
120pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -padx 10 -pady 10 -anchor w
121# Don't need to do very much with this label except turn off the border
122label $w.right.l -bd 0
123pack $w.right.l -side top -expand yes -padx 10 -pady 10
124
125# This is a base-64-encoded animated GIF file.
126set tclPoweredData {
127    R0lGODlhKgBAAPQAAP//////zP//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz//8zM
128    zMyZmcyZZsxmZsxmAMwzAJnMzJmZzJmZmZlmmZlmZplmM5kzM2aZzGZmzGZm
129    mWZmZmYzZmYzMzNmzDMzZgAzmSH+IE1hZGUgd2l0aCBHSU1QIGJ5IExARGVt
130    YWlsbHkuY29tACH5BAVkAAEALAAAAAAqAEAAAAX+YCCOZEkyTKM2jOm66yPP
131    dF03bx7YcuHIDkGBR7SZeIyhTID4FZ+4Es8nQyCe2EeUNJ0peY2s9mi7PhAM
132    ngEAMGRbUpvzSxskLh1J+Hkg134OdDIDEB+GHxtYMEQMTjMGEYeGFoomezaC
133    DZGSHFmLXTQKkh8eNQVpZ2afmDQGHaOYSoEyhhcklzVmMpuHnaZmDqiGJbg0
134    qFqvh6UNAwB7VA+OwydEjgujkgrPNhbTI8dFvNgEYcHcHx0lB1kX2IYeA2G6
135    NN0YfkXJ2BsAMuAzHB9cZMk3qoEbRzUACsRCUBK5JxsC3iMiKd8GN088SIyT
136    0RAFSROyeEg38caDiB/+JEgqxsODrZJ1BkT0oHKSmI0ceQxo94HDpg0qsuDk
137    UmRAMgu8OgwQ+uIJgUMVeGXA+IQkzEeHGvD8cIGlDXsLiRjQ+EHroQhea7xY
138    8IQBSgYYDi1IS+OFBCgaDMGVS3fGi5BPJpBaENdQ0EomKGD56IHwO39EXiSC
139    Ysgxor5+Xfgq0qByYUpiXmwuoredB2aYH4gWWda0B7SeNENpEJHC1ghi+pS4
140    AJpIAwWvKPBi+8YEht5EriEqpFfMlhEdkBNpx0HUhwypx5T4IB1MBg/Ws2sn
141    wV3MSQOkzI8fUd48Aw3dOZto71x85hHtHijYv18Gf/3GqCdDCXHNoICBobSo
142    IqBqJLyCoH8JPrLgdh88CKCFD0CGmAiGYPgffwceZh6FC2ohIIklnkhehTNY
143    4CIHHGzgwYw01ujBBhvAqKOLLq5AAk9kuSPkkKO40NB+h1gnypJIIvkBf09a
144    N5QIRz5p5ZJXJpmlIVhOGQA2TmIJZZhKKmmll2BqyWSXWUrZpQtpatlmk1c2
145    KaWRHeTZEJF8SqLDn/hhsOeQgBbqAh6DGqronxeARUIIACH5BAUeAAAALAUA
146    LgAFAAUAAAUM4CeKz/OV5YmqaRkCACH5BAUeAAEALAUALgAKAAUAAAUUICCK
147    z/OdJVCaa7p+7aOWcDvTZwgAIfkEBR4AAQAsCwAuAAkABQAABRPgA4zP95zA
148    eZqoWqqpyqLkZ38hACH5BAUKAAEALAcALgANAA4AAAU7ICA+jwiUJEqeKau+
149    r+vGaTmac63v/GP9HM7GQyx+jsgkkoRUHJ3Qx0cK/VQVTKtWwbVKn9suNunc
150    WkMAIfkEBQoAAAAsBwA3AAcABQAABRGgIHzk842j+Yjlt5KuO8JmCAAh+QQF
151    CgAAACwLADcABwAFAAAFEeAnfN9TjqP5oOWziq05lmUIACH5BAUKAAAALA8A
152    NwAHAAUAAAUPoPCJTymS3yiQj4qOcPmEACH5BAUKAAAALBMANwAHAAUAAAUR
153    oCB+z/MJX2o+I2miKimiawgAIfkEBQoAAAAsFwA3AAcABQAABRGgIHzfY47j
154    Q4qk+aHl+pZmCAAh+QQFCgAAACwbADcABwAFAAAFEaAgfs/zCV9qPiNJouo7
155    ll8IACH5BAUKAAAALB8ANwADAAUAAAUIoCB8o0iWZggAOw==
156}
157
158# Finally, set up the text scrolling animation
159animateLabelText $w.left.l1 "* Slow Animation *" 300
160animateLabelText $w.left.l2 "* Fast Animation *" 80
161animateLabelText $w.left.l3 "This is a longer scrolling text in a widget that will not show the whole message at once. " 150
162animateLabelImage $w.right.l $tclPoweredData 100
163