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