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