mingw/lib/tk8.5/demos/anilabel.tcl

   1 # anilabel.tcl --
   2 #
   3 # This demonstration script creates a toplevel window containing
   4 # several animated label widgets.
   5 #
   6 # RCS: @(#) $Id: anilabel.tcl,v 1.2 2004/12/21 11:56:35 dkf Exp $
   7
   8 if {![info exists widgetDemo]} {
   9     error "This script should be run from the \"widget\" demo."
  10 }
  11
  12 package require Tk
  13
  14 set w .anilabel
  15 catch {destroy $w}
  16 toplevel $w
  17 wm title $w "Animated Label Demonstration"
  18 wm iconname $w "anilabel"
  19 positionWindow $w
  20
  21 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."
  22 pack $w.msg -side top
  23
  24 ## See Code / Dismiss buttons
  25 set btns [addSeeDismiss $w.buttons $w]
  26 pack $btns -side bottom -fill x
  27
  28 # Ensure that this this is an array
  29 array 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.
  36 proc 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.
  50 proc 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.
  70 proc 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 }
  86 proc 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
 112 labelframe $w.left -text "Scrolling Texts"
 113 labelframe $w.right -text "GIF Image"
 114 pack $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
 117 label $w.left.l1 -bd 4 -relief ridge -font fixedFont
 118 label $w.left.l2 -bd 4 -relief groove -font fixedFont
 119 label $w.left.l3 -bd 4 -relief flat -font fixedFont -width 18
 120 pack $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
 122 label $w.right.l -bd 0
 123 pack $w.right.l -side top -expand yes -padx 10 -pady 10
 124
 125 # This is a base-64-encoded animated GIF file.
 126 set 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
 159 animateLabelText $w.left.l1 "* Slow Animation *" 300
 160 animateLabelText $w.left.l2 "* Fast Animation *" 80
 161 animateLabelText $w.left.l3 "This is a longer scrolling text in a widget that will not show the whole message at once. " 150
 162 animateLabelImage $w.right.l $tclPoweredData 100