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

   1 # aniwave.tcl --
   2 #
   3 # This demonstration script illustrates how to adjust canvas item
   4 # coordinates in a way that does something fairly similar to waveform
   5 # display.
   6 #
   7 # RCS: @(#) $Id: aniwave.tcl,v 1.2 2004/12/21 11:56:35 dkf Exp $
   8
   9 if {![info exists widgetDemo]} {
  10     error "This script should be run from the \"widget\" demo."
  11 }
  12
  13 package require Tk
  14
  15 set w .aniwave
  16 catch {destroy $w}
  17 toplevel $w
  18 wm title $w "Animated Wave Demonstration"
  19 wm iconname $w "aniwave"
  20 positionWindow $w
  21
  22 label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line."
  23 pack $w.msg -side top
  24
  25 ## See Code / Dismiss buttons
  26 set btns [addSeeDismiss $w.buttons $w]
  27 pack $btns -side bottom -fill x
  28
  29 # Create a canvas large enough to hold the wave. In fact, the wave
  30 # sticks off both sides of the canvas to prevent visual glitches.
  31 pack [canvas $w.c -width 300 -height 200 -background black] -padx 10 -pady 10 -expand yes
  32
  33 # Ensure that this this is an array
  34 array set animationCallbacks {}
  35
  36 # Creates a coordinates list of a wave. This code does a very sketchy
  37 # job and relies on Tk's line smoothing to make things look better.
  38 set waveCoords {}
  39 for {set x -10} {$x<=300} {incr x 5} {
  40     lappend waveCoords $x 100
  41 }
  42 lappend waveCoords $x 0 [incr x 5] 200
  43
  44 # Create a smoothed line and arrange for its coordinates to be the
  45 # contents of the variable waveCoords.
  46 $w.c create line $waveCoords -tags wave -width 1 -fill green -smooth 1
  47 proc waveCoordsTracer {w args} {
  48     global waveCoords
  49     # Actual visual update will wait until we have finished
  50     # processing; Tk does that for us automatically.
  51     $w.c coords wave $waveCoords
  52 }
  53 trace add variable waveCoords write [list waveCoordsTracer $w]
  54
  55 # Basic motion handler. Given what direction the wave is travelling
  56 # in, it advances the y coordinates in the coordinate-list one step in
  57 # that direction.
  58 proc basicMotion {} {
  59     global waveCoords direction
  60     set oc $waveCoords
  61     for {set i 1} {$i<[llength $oc]} {incr i 2} {
  62         if {$direction eq "left"} {
  63             lset waveCoords $i [lindex $oc \
  64                     [expr {$i+2>[llength $oc] ? 1 : $i+2}]]
  65         } else {
  66             lset waveCoords $i \
  67                     [lindex $oc [expr {$i-2<0 ? "end" : $i-2}]]
  68         }
  69     }
  70 }
  71
  72 # Oscillation handler. This detects whether to reverse the direction
  73 # of the wave by checking to see if the peak of the wave has moved off
  74 # the screen (whose size we know already.)
  75 proc reverser {} {
  76     global waveCoords direction
  77     if {[lindex $waveCoords 1] < 10} {
  78         set direction "right"
  79     } elseif {[lindex $waveCoords end] < 10} {
  80         set direction "left"
  81     }
  82 }
  83
  84 # Main animation "loop". This calls the two procedures that handle the
  85 # movement repeatedly by scheduling asynchronous calls back to itself
  86 # using the [after] command. This procedure is the fundamental basis
  87 # for all animated effect handling in Tk.
  88 proc move {} {
  89     basicMotion
  90     reverser
  91
  92     # Theoretically 100 frames-per-second (==10ms between frames)
  93     global animationCallbacks
  94     set animationCallbacks(simpleWave) [after 10 move]
  95 }
  96
  97 # Initialise our remaining animation variables
  98 set direction "left"
  99 set animateAfterCallback {}
 100 # Arrange for the animation loop to stop when the canvas is deleted
 101 bind $w.c <Destroy> {
 102     after cancel $animationCallbacks(simpleWave)
 103     unset animationCallbacks(simpleWave)
 104 }
 105 # Start the animation processing
 106 move