Bouncing Ball Animation (on a canvas)
FROM: http://wiki.tcl.tk/4293
(imaged on 2009 mar 19)



 package require Tk

 # drawBall --
 #    Draw a red circle at a certain height above the green ground
 #
 # Arguments:
 #    time     Time parameter, used to calculate the actual height
 #
 # Result:
 #    None
 #
 # Note:
 #    Assume a perfectly elastic collision. The time parameter must
 #    be reduced to the time since the last collision.
 #
 proc drawBall {time} {
   global accel
   global velo0
   global cnv_height
   global cnv_width

   set period [expr {2.0*$velo0/$accel}]
   set time2  [expr {$time - $period * int($time/$period)}]

   set grass_height 20
   set radius        7
   set ball_height   [expr {$velo0*$time2-0.5*$accel*$time2*$time2}]
   set pix_height [expr {
                 $cnv_height-$grass_height - $radius - $ball_height}]

   set xl     [expr {0.5*$cnv_width-$radius}]
   set xr     [expr {0.5*$cnv_width+$radius}]
   set yb     [expr {int($pix_height)-$radius}]
   set yt     [expr {int($pix_height)+$radius}]

   .cnv delete all
   .cnv create rectangle 0 $cnv_height $cnv_width \
      [expr {$cnv_height-$grass_height}] -fill green -outline green
   .cnv create oval      $xl $yb $xr $yt -fill red -outline black
 }

 # nextPicture --
 #    Prepare to call the next picture, stop after some predefined
 #    number of steps.
 #
 # Arguments:
 #    step     Step number (converted to time)
 #
 # Result:
 #    None
 #
 proc nextPicture {step} {

   # Here you can insert the code to save the current picture
   #
   # exec xwd -id [winfo id .cnv] -out [format "anim%04d.xwd" $step]
   #

   #
   # Draw the picture
   #
   drawBall [expr {0.1*$step}]

   #
   # Set up the next picture via the [after] command
   #
   if { $step < 1000 } {
      incr step
      after 100 [list nextPicture $step]
   }
 }

 # main --
 #   Set up the canvas, start the loop
 #

 global cnv_width
 global cnv_height
 global velo0
 global accel

 set cnv_width   400
 set cnv_height  300

 set velo0        70.0  ;# m/s
 set accel        10.0  ;# m/s2
                       ;# pixels become m that way :)

 canvas .cnv -width $cnv_width -height $cnv_height -background white
 pack   .cnv -fill both

 drawBall 0
 #
 # Wait until the dust settles - important for saving the frames
 # on a slow system
 #
 tkwait visibility .
 nextPicture 0