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