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$
8
9if {![info exists widgetDemo]} {
10    error "This script should be run from the \"widget\" demo."
11}
12
13package require Tk
14
15set w .aniwave
16catch {destroy $w}
17toplevel $w
18wm title $w "Animated Wave Demonstration"
19wm iconname $w "aniwave"
20positionWindow $w
21
22label $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."
23pack $w.msg -side top
24
25## See Code / Dismiss buttons
26set btns [addSeeDismiss $w.buttons $w]
27pack $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.
31pack [canvas $w.c -width 300 -height 200 -background black] -padx 10 -pady 10 -expand yes
32
33# Ensure that this this is an array
34array 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.
38set waveCoords {}
39for {set x -10} {$x<=300} {incr x 5} {
40    lappend waveCoords $x 100
41}
42lappend 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
47proc 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}
53trace 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.
58proc 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.)
75proc 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.
88proc 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
98set direction "left"
99set animateAfterCallback {}
100# Arrange for the animation loop to stop when the canvas is deleted
101bind $w.c <Destroy> {
102    after cancel $animationCallbacks(simpleWave)
103    unset animationCallbacks(simpleWave)
104}
105# Start the animation processing
106move
107