(* This mathematica file creates the files bounce0.anim, bounce1.anim, and
   bounce2.anim which animate a bouncing ball. bounce0.anim only shows
   the ball together with a clock and axes. bounce1.anim and the graph,
   and bounce2.anim the graph of the derivative as well.  (Actually we
   show a graph of the derivative divided by 20, so that the same axes
   can be used for the function and the derivative.

   Note: be sure to compress these files (they are big, but
   compress a lot).  View the animations with a command like "motifps
   bounce0.anim".

   The ball is released at time 0 from 100 centimeters.  We display
   its height versus time over the interval [0,3], measured in second,
   although it comes to rest at time 2.4 seconds.  The height function
   is a piecewise quadratic.  It is reasonably realistic, but not meant
   to conform to any exact model.

   Douglas N. Arnold, 8/29/92, 8/25/94

   Douglas N. Arnold  <dna@math.psu.edu>
   Department of Mathematics
   Penn State
   University Park, PA  16802

   Online documentation related to this file can be found at WWW URL
   http://www.math.psu.edu/dna/graphics.html.
*)

BeginPackage["Bounce`", "Graphics`Animation`", "Graphics`Colors`"]

Begin["Private`"]

(* Define the ground contact times.  These have been adjusted to give a
fairly realistic bouncing ball, but also to be integers/20.  This way we
can animate with frames every 1/20 second and the ball always hits the
ground exactly at a frame time.
*)

xp = {-10, 10, 23, 32, 38, 42, 45, 47, 48}/20
g[x_]:= 0 /; x <= First[xp] || x >= Last[xp]
g[x_]:=
  Module[{m},
    m = Last[Position[Map[(#<x)&,xp],True]][[1]];
    Return[400(x-xp[[m]])(xp[[m+1]]-x)]; ]

(* Define its derivative divided by 20 *)

gp[x_]:= 0 /; x <= First[xp] || x >= Last[xp]
gp[x_]:=
  Module[{m},
    m = Last[Position[Map[(#<x)&,xp],True]][[1]];
    Return[20(xp[[m]]+xp[[m+1]]-2 x)]; ]

(* Set limits of display, times for frames, and options to ShowAnimation. *)

    {{xmin,xmax},{ymin,ymax}} = {{-.5,3},{-20,120}}
    times = Table[t,{t,0,3,1/20}]
    opts0 = ( AnimationFunction -> (DisplayAnimation["bounce0.anim",#]&) )
    opts1 = ( AnimationFunction -> (DisplayAnimation["bounce1.anim",#]&) )
    opts2 = ( AnimationFunction -> (DisplayAnimation["bounce2.anim",#]&) )

(* Define a single frame of the animation. *)

frame[i_,showgraph_,showdgraph_] :=
        ( x = N[times[[i]]];
        y = g[x];
(* Create the graph, a polyline plotting the height of the ball versus time
   from time 0 to the present moment.  Use the points with integer abscissas
   as breakpoints for the polyline except include the present point as
   well and include the starting point twice so that Line doesn't get
   confused on the first frame when it has only one endpoint. *)
        graph = If[showgraph,
         { Blue, Thickness[0.007],
             Line[Map[{#,g[#]}& , Prepend[Union[Table[t,{t,0,x,1/20}],{x}],0]]]},
     {} ] ;
(* Create the graph of the derivative.  This is a bit of a bother since
   the derivative is undefined at the break points.  *)
   dgraph = If[showdgraph,
     eps = .005;
     m = Last[Position[Map[(#<x)&,xp],True]][[1]];
     Flatten[{Red, Thickness[0.007],
     Table[Line[Map[{#,gp[#]}&,{Max[xp[[j]],0]+eps,xp[[j+1]]-eps}]],{j,1,m-1}] ,
     Line[Map[{#,gp[#]}&,{Max[xp[[m]],0]+eps,Max[x,2 eps]-eps}]] }],
     {} ] ;
(* Create axes for the graph. *)
	axes = {Black, Thickness[0.001], Line[{{0,-20},{0,120}}],
	        Line[{{0,0},{60,0}}]};
(* Create a solid rectangle for the ball to bounce on. *)
	rectangle = {Black, Polygon[{{-.5,-20},{0,-20},{0,-3},{-.5,-3}}]};
(* Create a bouncing ball. *)
	ball = {Pink, PointSize[0.03], Point[{-.25,y}]};
	dot = {Black, PointSize[0.005], Point[{-.25,y}]};
(* Create the clock. *)
        xc = xmin + .75 (xmax-xmin);
	yc = ymin + .75 (ymax-ymin);
	xr = .1 (xmax-xmin);
	yr = .15 (ymax-ymin);
	border = {Goldenrod, Thickness[0.001],
	Polygon[Table[{xc,yc}+ {xr Cos[th],yr Sin[th]},{th,0,Pi, Pi/25}]]};
        base = {Goldenrod, Thickness[0.001],
	Polygon[{{xc-xr,yc},{xc-xr,yc-yr/4},{xc+xr,yc-yr/4},{xc+xr,yc} }]};
	minordots = Flatten[{Black,PointSize[0.006],
	Table[Point[{xc,yc}+ {xr Cos[th],yr Sin[th]}],{th,0,Pi,Pi/30}]}];
	majordots = Flatten[{Black,PointSize[0.012],
	Table[Point[{xc,yc}+ {xr Cos[th],yr Sin[th]}],{th,0,Pi,Pi/6}]}];
	centerdot = {Black,PointSize[0.02],Point[{xc,yc}]};
	numbers = {Text[0,{xc-1.2 xr,yc}],
                   Text[1,{xc-.6 xr,yc+.6 Sqrt[3]yr}],
                   Text[2,{xc+.6 xr,yc+.6 Sqrt[3]yr}],
                   Text[3,{xc+1.2 xr,yc}]};
	clockhand = {Black,Thickness[0.005],
               Line[{{xc,yc},{xc,yc}
                   +.85 {xr Cos[Pi-Pi x/3],yr Sin[Pi-Pi x/3]}}]};
	clock =
         Flatten[{border,base,majordots,minordots,centerdot,numbers,clockhand}];
(* Combine everything in a Graphics object. *)
        Graphics[Flatten[{ graph, dgraph, axes, rectangle, ball, dot, clock }],
          PlotRange->{{xmin,xmax},{ymin,ymax}}, Frame->True] )

(* Create the animation. *)

(* The next three lines will create Mathematica animation files. *)

ShowAnimation[Table[frame[i,False,False],{i,1,Length[times]}],opts0]
ShowAnimation[Table[frame[i,True,False],{i,1,Length[times]}],opts1]
ShowAnimation[Table[frame[i,True,True],{i,1,Length[times]}],opts2]

(* The next lines rasterize each frame separately to ppm format.
   These can be used with makempg to create mpeg files. *)

(*
writetofile[i_] := StringJoin["!rasterps -format ppm > bounce0.",ToString[PaddedForm[i,3,NumberPadding->{"0",""}]],".ppm"]
Table[ Display[writetofile[i],frame[i,False,False]],
  {i,1,Length[times]}]
writetofile[i_] := StringJoin["!rasterps -format ppm > bounce1.",ToString[PaddedForm[i,3,NumberPadding->{"0",""}]],".ppm"]
Table[ Display[writetofile[i],frame[i,True,False]],
  {i,1,Length[times]}]
writetofile[i_] := StringJoin["!rasterps -format ppm > bounce2.",ToString[PaddedForm[i,3,NumberPadding->{"0",""}]],".ppm"]
Table[ Display[writetofile[i],frame[i,True,True]],
  {i,1,Length[times]}]
*)


End[] (* end of context private *)

EndPackage[]

(* write an exit message *)

Print["-- wrote files bounce0.anim, bounce1.anim, and bounce2.anim --"]