diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | library/demos/aniwave.tcl | 104 | ||||
| -rw-r--r-- | library/demos/pendulum.tcl | 194 | ||||
| -rw-r--r-- | library/demos/widget | 4 |
4 files changed, 304 insertions, 3 deletions
@@ -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" |