More animation demos

4 files changed, 304 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index d0bf0cc..fff7138 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -12,8 +12,9 @@
 
 2004-11-07  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
-	* library/demos/anilabel.tcl: Added a simple demonstration of how
-	to do animation using Tcl/Tk to the widget demo.
+	* library/demos/pendulum.tcl:	Added demonstrations of how to do
+	* library/demos/aniwave.tcl:	animations using Tcl/Tk to the
+	* library/demos/anilabel.tcl:	widget demo.
 
 2004-11-03  Don Porter  <dgp@users.sourceforge.net>
 
diff --git a/library/demos/aniwave.tcl b/library/demos/aniwave.tcl
new file mode 100644
index 0000000..824388c
--- /dev/null
+++ b/library/demos/aniwave.tcl
@@ -0,0 +1,104 @@
+# aniwave.tcl --
+#
+# This demonstration script illustrates how to adjust canvas item
+# coordinates in a way that does something fairly similar to waveform
+# display.
+#
+# RCS: @(#) $Id: aniwave.tcl,v 1.1 2004/11/07 22:41:11 dkf Exp $
+
+if {![info exists widgetDemo]} {
+    error "This script should be run from the \"widget\" demo."
+}
+
+set w .aniwave
+catch {destroy $w}
+toplevel $w
+wm title $w "Animated Wave Demonstration"
+wm iconname $w "aniwave"
+positionWindow $w
+
+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." 
+pack $w.msg -side top
+
+## See Code / Dismiss buttons
+set btns [addSeeDismiss $w.buttons $w]
+pack $btns -side bottom -fill x
+
+# Create a canvas large enough to hold the wave. In fact, the wave
+# sticks off both sides of the canvas to prevent visual glitches.
+pack [canvas $w.c -width 300 -height 200 -background black] -padx 10 -pady 10 -expand yes
+
+# Ensure that this this is an array
+array set animationCallbacks {}
+
+# Creates a coordinates list of a wave. This code does a very sketchy
+# job and relies on Tk's line smoothing to make things look better.
+set waveCoords {}
+for {set x -10} {$x<=300} {incr x 5} {
+    lappend waveCoords $x 100
+}
+lappend waveCoords $x 0 [incr x 5] 200
+
+# Create a smoothed line and arrange for its coordinates to be the
+# contents of the variable waveCoords.
+$w.c create line $waveCoords -tags wave -width 1 -fill green -smooth 1
+proc waveCoordsTracer {w args} {
+    global waveCoords
+    # Actual visual update will wait until we have finished
+    # processing; Tk does that for us automatically.
+    $w.c coords wave $waveCoords
+}
+trace add variable waveCoords write [list waveCoordsTracer $w]
+
+# Basic motion handler. Given what direction the wave is travelling
+# in, it advances the y coordinates in the coordinate-list one step in
+# that direction.
+proc basicMotion {} {
+    global waveCoords direction
+    set oc $waveCoords
+    for {set i 1} {$i<[llength $oc]} {incr i 2} {
+	if {$direction eq "left"} {
+	    lset waveCoords $i [lindex $oc \
+		    [expr {$i+2>[llength $oc] ? 1 : $i+2}]]
+	} else {
+	    lset waveCoords $i \
+		    [lindex $oc [expr {$i-2<0 ? "end" : $i-2}]]
+	}
+    }
+}
+
+# Oscillation handler. This detects whether to reverse the direction
+# of the wave by checking to see if the peak of the wave has moved off
+# the screen (whose size we know already.)
+proc reverser {} {
+    global waveCoords direction
+    if {[lindex $waveCoords 1] < 10} {
+	set direction "right"
+    } elseif {[lindex $waveCoords end] < 10} {
+	set direction "left"
+    }
+}
+
+# Main animation "loop". This calls the two procedures that handle the
+# movement repeatedly by scheduling asynchronous calls back to itself
+# using the [after] command. This procedure is the fundamental basis
+# for all animated effect handling in Tk.
+proc move {} {
+    basicMotion
+    reverser
+
+    # Theoretically 100 frames-per-second (==10ms between frames)
+    global animationCallbacks
+    set animationCallbacks(simpleWave) [after 10 move]
+}
+
+# Initialise our remaining animation variables
+set direction "left"
+set animateAfterCallback {}
+# Arrange for the animation loop to stop when the canvas is deleted
+bind $w.c <Destroy> {
+    after cancel $animationCallbacks(simpleWave)
+    unset animationCallbacks(simpleWave)
+}
+# Start the animation processing
+move
diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl
new file mode 100644
index 0000000..7c5bd55
--- /dev/null
+++ b/library/demos/pendulum.tcl
@@ -0,0 +1,194 @@
+# pendulum.tcl --
+#
+# This demonstration illustrates how Tcl/Tk can be used to construct
+# simulations of physical systems.
+#
+# RCS: @(#) $Id: pendulum.tcl,v 1.1 2004/11/07 22:41:11 dkf Exp $
+
+if {![info exists widgetDemo]} {
+    error "This script should be run from the \"widget\" demo."
+}
+
+set w .pendulum
+catch {destroy $w}
+toplevel $w
+wm title . "Pendulum Animation Demonstration"
+wm iconname $w "pendulum"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration shows how Tcl/Tk can be used to carry out animations that are linked to simulations of physical systems. In the left canvas is a graphical representation of the physical system itself, a simple pendulum, and in the right canvas is a graph of the phase space of the system, which is a plot of the angle (relative to the vertical) against the angular velocity. The pendulum bob may be repositioned by clicking and dragging anywhere on the left canvas."
+pack $w.msg
+
+## See Code / Dismiss buttons
+set btns [addSeeDismiss $w.buttons $w]
+pack $btns -side bottom -fill x
+
+# Create some structural widgets
+pack [panedwindow $w.p] -fill both -expand 1
+$w.p add [labelframe $w.p.l1 -text "Pendulum Simulation"]
+$w.p add [labelframe $w.p.l2 -text "Phase Space"]
+
+# Create the canvas containing the graphical representation of the
+# simulated system.
+canvas $w.c -width 320 -height 200 -background white -bd 2 -relief sunken
+$w.c create text 5 5 -anchor nw -text "Click to Adjust Bob Start Position"
+# Coordinates of these items don't matter; they will be set properly below
+$w.c create line 0 25 320 25 -width 2 -fill grey50 -tags plate
+$w.c create line 1 1 1 1 -tags pendulumRod -width 3 -fill black
+$w.c create oval 1 1 2 2 -tags pendulumBob -fill yellow -outline black
+$w.c create oval 155 20 165 30 -fill grey50 -outline {}
+pack $w.c -in $w.p.l1 -fill both -expand true
+
+# Create the canvas containing the phase space graph; this consists of
+# a line that gets gradually paler as it ages, which is an extremely
+# effective visual trick.
+canvas $w.k -width 320 -height 200 -background white -bd 2 -relief sunken
+$w.k create line 160 200 160 0 -fill grey75 -arrow last -tags y_axis
+$w.k create line 0 100 320 100 -fill grey75 -arrow last -tags x_axis
+for {set i 90} {$i>=0} {incr i -10} {
+    # Coordinates of these items don't matter; they will be set properly below
+    $w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i
+}
+# FIXME: UNICODE labels
+$w.k create text 0 0 -anchor ne -text "q" -font {Symbol 8} -tags label_theta
+$w.k create text 0 0 -anchor ne -text "dq" -font {Symbol 8} -tags label_dtheta
+pack $w.k -in $w.p.l2 -fill both -expand true
+
+# Initialize some variables
+set points {}
+set Theta   45.0
+set dTheta   0.0
+set pi       3.1415926535897933
+set length 150
+
+# This procedure makes the pendulum appear at the correct place on the
+# canvas. If the additional arguments "at $x $y" are passed (the 'at'
+# is really just syntactic sugar) instead of computing the position of
+# the pendulum from the length of the pendulum rod and its angle, the
+# length and angle are computed in reverse from the given location
+# (which is taken to be the centre of the pendulum bob.)
+proc showPendulum {canvas {at {}} {x {}} {y {}}} {
+    global Theta dTheta pi length
+    if {$at eq "at" && ($x!=160 || $y!=25)} {
+	set dTheta 0.0
+	set x2 [expr {$x-160}]
+	set y2 [expr {$y-25}]
+	set length [expr {hypot($x2,$y2)}]
+	set Theta [expr {atan2($x2,$y2)*180/$pi}]
+    } else {
+	set angle [expr {$Theta * $pi/180}]
+	set x [expr {160+$length*sin($angle)}]
+	set y [expr {25+$length*cos($angle)}]
+    }
+    $canvas coords pendulumRod 160 25 $x $y
+    $canvas coords pendulumBob \
+	    [expr {$x-15}] [expr {$y-15}] [expr {$x+15}] [expr {$y+15}]
+}
+showPendulum $w.c
+
+# Update the phase-space graph according to the current angle and the
+# rate at which the angle is changing (the first derivative with
+# respect to time.)
+proc showPhase {canvas} {
+    global Theta dTheta points psw psh
+    lappend points [expr {$Theta+$psw}] [expr {-20*$dTheta+$psh}]
+    if {[llength $points] > 100} {
+    	 set points [lrange $points end-99 end]
+    }
+    for {set i 0} {$i<100} {incr i 10} {
+	set list [lrange $points end-[expr {$i-1}] end-[expr {$i-12}]]
+	if {[llength $list] >= 4} {
+	    $canvas coords graph$i $list
+	}
+    }
+}
+
+# Set up some bindings on the canvases.  Note that when the user
+# clicks we stop the animation until they release the mouse
+# button. Also note that both canvases are sensitive to <Configure>
+# events, which allows them to find out when they have been resized by
+# the user.
+bind $w.c <Destroy> {
+    after cancel $animationCallbacks(pendulum)
+    unset animationCallbacks(pendulum)
+}
+bind $w.c <1> {
+    after cancel $animationCallbacks(pendulum)
+    showPendulum %W at %x %y
+}
+bind $w.c <B1-Motion> {
+    showPendulum %W at %x %y
+}
+bind $w.c <ButtonRelease-1> {
+    showPendulum %W at %x %y
+    set animationCallbacks(pendulum) [after 15 repeat [winfo toplevel %W]]
+}
+bind $w.c <Configure> {
+    %W coords plate 0 25 %w 25
+}
+bind $w.k <Configure> {
+    set psh [expr %h/2]
+    set psw [expr %w/2]
+    %W coords x_axis 2 $psh [expr %w-2] $psh
+    %W coords y_axis $psw [expr %h-2] $psw 2
+    %W coords label_dtheta [expr $psw-4] 6
+    %W coords label_theta [expr %w-6] [expr $psh+4]
+}
+
+# This procedure is the "business" part of the simulation that does
+# simple numerical integration of the formula for a simple rotational
+# pendulum.
+proc recomputeAngle {} {
+    global Theta dTheta pi length
+    set scaling [expr {3000.0/$length/$length}]
+
+    # To estimate the integration accurately, we really need to
+    # compute the end-point of our time-step.  But to do *that*, we
+    # need to estimate the integration accurately!  So we try this
+    # technique, which is inaccurate, but better than doing it in a
+    # single step.  What we really want is bound up in the
+    # differential equation:
+    #       ..             - sin theta
+    #      theta + theta = -----------
+    #                         length
+    # But my math skills are not good enough to solve this!
+
+    # first estimate
+    set firstDDTheta [expr {-sin($Theta * $pi/180)*$scaling}]
+    set midDTheta [expr {$dTheta + $firstDDTheta}]
+    set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}]
+    # second estimate
+    set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}]
+    set midDTheta [expr {$dTheta + ($firstDDTheta + $midDDTheta)/2}]
+    set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}]
+    # Now we do a double-estimate approach for getting the final value
+    # first estimate
+    set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}]
+    set lastDTheta [expr {$midDTheta + $midDDTheta}]
+    set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}]
+    # second estimate
+    set lastDDTheta [expr {-sin($lastTheta * $pi/180)*$scaling}]
+    set lastDTheta [expr {$midDTheta + ($midDDTheta + $lastDDTheta)/2}]
+    set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}]
+    # Now put the values back in our globals
+    set dTheta $lastDTheta
+    set Theta $lastTheta
+}
+
+# This method ties together the simulation engine and the graphical
+# display code that visualizes it.
+proc repeat w {
+    global animationCallbacks
+
+    # Simulate
+    recomputeAngle
+
+    # Update the display
+    showPendulum $w.c
+    showPhase $w.k
+
+    # Reschedule ourselves
+    set animationCallbacks(pendulum) [after 15 [list repeat $w]]
+}
+# Start the simulation after a short pause
+set animationCallbacks(pendulum) [after 500 [list repeat $w]]
diff --git a/library/demos/widget b/library/demos/widget
index 36b9871..1924daa 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -11,7 +11,7 @@ exec wish "$0" "$@"
 # ".tcl" files is this directory, which are sourced by this script
 # as needed.
 #
-# RCS: @(#) $Id: widget,v 1.25 2004/11/07 17:28:21 dkf Exp $
+# RCS: @(#) $Id: widget,v 1.26 2004/11/07 22:41:11 dkf Exp $
 
 package require Tcl	8.5
 package require Tk	8.5
@@ -329,6 +329,8 @@ addDemoSection "Common Dialogs" {
 }
 addDemoSection "Animation" {
     anilabel	"Animated labels"
+    aniwave	"Animated wave"
+    pendulum	"Pendulum simulation"
 }
 addDemoSection "Miscellaneous" {
     bitmap	"The built-in bitmaps"