
(* Copyright 1989, 1990 Wolfram Research, Inc. *)

(*:Version: Mathematica 2.0 *)

(*:Title: Control Functions for Animation *)

(*:Author:
	R. Maeder, after a version by Theodore Gray and David Ballman
*)

(*:Keywords:
	Animation, Movie, Animate
*)

(*:Requirements: Machine-dependent animation capabilities.  If such
are available, the machine-specific definitions for rendering
animations will be set up in the graphics initialization files, such
as X11.ps *)

(*:Sources: none. *)

(*:Summary:  This file contains various animation functions for
regular x-y, density, contour, and parametric curve plots.  Animation
of three-dimensional plots and rotation of two-dimensional plots
is also supported.
*)


BeginPackage["Graphics`Animation`", "Geometry`Rotations`"]

Animation::usage = "Graphics/Animation.m contains various animation functions.
	Options used are: RasterFunction, AnimationFunction, Frames, and Closed.
	They pass any extra options to the embedded Show[] command to render
	the frames."

ShowAnimation::usage = "ShowAnimation[{g,h,...}, options...] produces
	an animation from a sequence of graphics objects."

System`DisplayAnimation::usage = "DisplayAnimation[file, glist] writes the
	PostScript code of all frames in the list of graphics glist to file.
	The frames are separated by cell header lines. file can be animated
	under the Notebook front end or in most PostScript renderers supplied
	with Mathematica."

Animate::usage = "Animate[command, iterator, options...] uses the
	iterator to run the specified graphics command,
	and animates the results."

MoviePlot::usage = "MoviePlot[f[x,t], {x,x0,x1}, {t,t0,t1}, options...] will
	animate plots of f[x,t] regarded as a function of x, with t serving as
	the animation (or time) variable."

MoviePlot3D::usage = "MoviePlot3D[f[x,y,t], {x,x0,x1}, {y,y0,y1}, {t,t0,t1},
	options...] will animate x,y-plots of the given function by varying t."

MovieDensityPlot::usage = "MovieDensityPlot[f[x,y,t], {x,x0,x1}, {y,y0,y1},
	{t,t0,t1}, options...] will animate x,y-density-plots of the given
	function by varying t."

MovieContourPlot::usage = "MovieContourPlot[f[x,y,t], {x,x0,x1}, {y,y0,y1},
	{t,t0,t1}, options...] will animate x,y-contour-plots of the given
	function by varying t."

MovieParametricPlot::usage = "MovieParametricPlot[{f[x,t],g{x,t}}, {x,x0,x1},
	{t,t0,t1}, options...] will animate parametric curve plots of the given
	function by varying t."

SpinShow::usage = "SpinShow[graphics, opts...]
	will animate a three-dimensional graphics object by rotating it."

RasterFunction::usage = "RasterFunction is an option of ShowAnimation[]
that specifies the function to use to rasterize the individual
frames in an animation.  It is also used by Animate[], MoviePlot[],
SpinShow[], etc."

AnimationFunction::usage = "AnimationFunction is an option of ShowAnimation[]
	that specifies the function to use to show the animation.
	It is also used by Animate[], MoviePlot[], SpinShow[], etc."

Frames::usage = "Frames is an option of Animate[] and SpinShow[] that specifies
	number of frames to render, if the animation iterator does not
	specify an increment."

Closed::usage = "Closed -> False/True is an option of Animate[]
and SpinShow[] that specifies whether the last value of the animation
iterator is assumed to give the same picture as the first one. If
True, the last frame is not rendered. For example, {t, 0, 2Pi},
Closed->True, Frames -> 24 will generate frames for t = 0, 2Pi/24,...,
2Pi - 2Pi/24."

Options[ ShowAnimation ] = {
	RasterFunction :> System`$RasterFunction,
	AnimationFunction :> System`$AnimationFunction
	}

Options[ Animate ] = {
	Frames -> 24,
	Closed -> False
	}

Options[SpinShow] = {
	Frames -> 24,
	Closed -> True,
	SpinOrigin -> {0,0,1.5},
	SpinTilt -> {0,0},
	SpinDistance -> 2,
	SpinRange -> {0 Degree, 360 Degree},
	RotateLights -> False
	}


Begin["`Private`"]

(* Here is how it works:
 *
 * For each frame, Show[ -graphics-, DisplayFunction -> $RasterFunction ]
 * is called. The results are saved in a list.
 * At the end, $AnimationFunction[ list ] is called.
 * Normally the idea is that $RasterFunction leaves a raster (or other)
 * image of the current frame in a file named filename.
 * $AnimationFunction then calls an external program to do the animation.
 * Alternatively, $RasterFunction can be Identity, collecting
 * the graphics themselves in the list.
 *
 * The values of these two functions should be set in
 * the device-dependent graphics initialization file.
 *
 * The defaults below concatenate the PostScript code of all frames
 * with the appropriate header information and write it to the file argument
 * of the default DisplayFunction--if this is indeed Display[].
 * This default is appropriate for the graphics renderers supplied
 * by Wolfram Research and for front end versions.
 *
 * With these values, the combined PostScript code of an animation can be saved
 * in the file file.anim with the command
 *
 *     ShowAnimation[glist, DisplayFunction->(Display["file.anim", #]&)]
 * or
 *     Animate[cmd, range, DisplayFunction->(Display["file.anim", #]&)]
 *
 * Independent of the machine-dependent setting, the following can be used:
 *
 *	DisplayAnimation["file.anim", glist]
 *
 *)
 
(* defaults for $RasterFunction and $AnimationFunction
   in case the graphics init file did not define them *)

If[ !ValueQ[System`$RasterFunction],
	$RasterFunction = Identity ]
If[ !ValueQ[System`$AnimationFunction],
	$AnimationFunction = System`DisplayAnimation ]

(* examine $DisplayFunction: is it Display[file, #]& ? *)

System`DisplayAnimation[pics_List] :=
	Module[{display},
		If[ Head[$DisplayFunction] === Function &&
		    HeldPart[$DisplayFunction, -1, 0] === Hold[Display],
		  display = HeldPart[$DisplayFunction, -1, 1][[1]];
		  DisplayAnimation[display, pics];
		  pics,
		(* else: show all frames *)
		  Show[#, DisplayFunction -> $DisplayFunction]& /@ pics
		]
	]

DisplayAnimation[disp_List, pics_] := DisplayAnimation[#, pics]& /@ disp

DisplayAnimation[display_, pics_] :=
	Module[{stream, nopen},
		stream = Streams[ display];
		nopen = (stream === {});
		If[nopen, stream = OpenWrite[ display]];
		If[ stream === $Failed, Return[stream]];
		WriteFrame[stream, #]& /@ pics;
		If[ nopen, Close[stream]];
		pics
	]

(* header line for animation cells *)

$AnimationCellString = ":[font = postscript; inactive; PostScript; output; preserveAspect; ]\n"

WriteFrame[stream_, pic_] := (
	WriteString[stream, $AnimationCellString];
	Display[stream, pic];
)

(* end of defaults section *)

FilterOptions[ command_Symbol, opts___ ] :=
	Module[{keywords = First /@ Options[command]},
		Sequence @@ Select[ {opts}, MemberQ[keywords, First[#]]& ]
	]

Pixelize[ go_, RasterFunction_, opts___ ] :=
	Module[ {gtype = Head[go]},
		While[ gtype === List && Length[gtype] > 0,
		       gtype = Head[gtype] ];
		Show[ go, DisplayFunction -> RasterFunction,
		          FilterOptions[gtype, opts] ]
	]


ShowAnimation[ gl_List, opts___ ] :=
	Module[{filelist, rasterFunction, animationFunction, SaveDisplay},
		rasterFunction = RasterFunction /. {opts} /. Options[ShowAnimation];
		animationFunction = AnimationFunction /. {opts} /. Options[ShowAnimation];
		SaveDisplay = DisplayFunction /. {opts} /. {DisplayFunction -> $DisplayFunction};
		filelist = Pixelize[#, rasterFunction, opts]& /@ gl;
		Block[{$DisplayFunction = SaveDisplay},
		  animationFunction[ filelist ]
		]
	]

Attributes[Animate] = {HoldFirst};
Animate[ function_, {t_, t0_, t1_, dt_:Automatic}, opts___ ] :=
	Module[{filelist, rasterFunction, animationFunction, SaveDisplay,
	       ndt = dt, closed, nt1 = t1, frames},
		closed = Closed /. {opts} /. Options[Animate];
		rasterFunction = RasterFunction /. {opts} /. Options[ShowAnimation];
		animationFunction = AnimationFunction /. {opts} /. Options[ShowAnimation];
		SaveDisplay = DisplayFunction /. {opts} /. {DisplayFunction -> $DisplayFunction};
		If[ dt === Automatic,
			frames = Frames-1 /. {opts} /. Options[Animate];
			If[ closed, frames++ ];
			ndt = (t1 - t0)/frames ];
		If[ closed, nt1 -= ndt];
		Block[{$DisplayFunction = Identity,
		       $SoundDisplayFunction = Identity},
		  filelist = Table[ Pixelize[function, rasterFunction, opts],
			          {t, t0, nt1, ndt} ]
		];
		Block[{$DisplayFunction = SaveDisplay},
		  animationFunction[ filelist ]
		]
	]

(* the following borrow their options from Animate[] *)

Attributes[MoviePlot] = {HoldFirst};
MoviePlot[ function_, xRange_List, animationRange_List, opts___ ] := 
	Animate[ Plot[function, xRange, DisplayFunction->Identity,
	            Evaluate[FilterOptions[Plot, opts]]], 
	       animationRange, FilterOptions[Animate, opts] ];

Attributes[MoviePlot3D] = {HoldFirst};
MoviePlot3D[ function_, xRange_List, yRange_List, animationRange_List, opts___ ] := 
	Animate[ Plot3D[function, xRange, yRange, DisplayFunction->Identity,
	            Evaluate[FilterOptions[Plot3D, opts]]], 
	       animationRange, FilterOptions[Animate, opts] ];

Attributes[MovieDensityPlot] = {HoldFirst};
MovieDensityPlot[function_, xRange_List, yRange_List, animationRange_List, opts___ ] :=
	Animate[ DensityPlot[function, xRange, yRange, DisplayFunction->Identity,
	            Evaluate[FilterOptions[DensityPlot, opts]]], 
	       animationRange, FilterOptions[Animate, opts] ];

Attributes[MovieContourPlot] = {HoldFirst};
MovieContourPlot[ function_, xRange_List, yRange_List, animationRange_List, opts___ ] := 
	Animate[ ContourPlot[function, xRange, yRange, DisplayFunction->Identity,
	            Evaluate[FilterOptions[ContourPlot, opts]]], 
	       animationRange, FilterOptions[Animate, opts] ];

Attributes[MovieParametricPlot] = {HoldFirst};
MovieParametricPlot[ function_, xRange_List, animationRange_List, opts___ ] := 
	Animate[ ParametricPlot[function, xRange, DisplayFunction->Identity,
	            Evaluate[FilterOptions[ParametricPlot, opts]]], 
	       animationRange, FilterOptions[Animate, opts] ];

SpinShow[theGraphic_, options___] :=
	Module[{ spinOrigin = SpinOrigin /. {options} /. Options[SpinShow],
		spinTilt = SpinTilt /. {options} /. Options[SpinShow],
		spinDistance = SpinDistance /. {options} /. Options[SpinShow],
		spinRange = SpinRange //. {options} //. Options[SpinShow],
		lightSources = LightSources /. {options} /.
				Flatten[Options[theGraphic]] /. Options[Head[theGraphic]],
		rotateLights = RotateLights /. {options} /. Options[SpinShow],
		closed = Closed /. {options} /. Options[SpinShow],
		frames = Frames /. {options} /. Options[SpinShow],
		thetaFactor, phiFactor, rhoFactor, theta },
	
	thetaFactor = Switch[rotateLights,  False, 0, 
	                                    True, 1,
	                                    Opposite, -1,
	                                    _, 0];
	phiFactor = If[rotateLights, 1, 0, 0];
	rhoFactor = If[rotateLights, 1, 0, 0];
	
	Animate[ Show[theGraphic, DisplayFunction -> Identity,
		    ViewPoint->(spinOrigin +
		     spinDistance Rotate3D[{1,0,0}, theta, spinTilt[[1]], spinTilt[[2]]]),
		    LightSources ->  Map[{Rotate3D[#[[1]], 
					thetaFactor theta,
					phiFactor spinTilt[[1]],
					rhoFactor spinTilt[[2]]], #[[2]]}&, 
					lightSources],
	            FilterOptions[Head[theGraphic], options],
	            SphericalRegion -> True],
	       {theta, spinRange[[1]], spinRange[[2]]},
	       Closed -> closed, Frames -> frames
	    ]
	]

End[]   (* Graphics`Animation`Private` *)

Protect[ShowAnimation, Animate, DisplayAnimation, MoviePlot, MoviePlot3D,
	MovieDensityPlot, MovieContourPlot, MovieParametricPlot, SpinShow,
	Frames, Closed, RasterFunction, AnimationFunction, SpinOrigin,
	SpinTilt, SpinDistance, SpinRange, RotateLights]

EndPackage[]   (* Graphics`Animation` *)

(*:Limitations: none known. *)

(*:Tests:

*)

(*:Examples:
Animate[ Plot[ Sin[x t], {x,-3,3}, PlotRange->{-1, 1} ], {t,0,1} ]

MoviePlot[ Sin[x t], {x,-5,5}, {t,0,1}, PlotRange->{-1, 1} ]

MoviePlot3D[ Sin[ x y t], {x,-2,2}, {y,-2,2}, {t,0,1}, PlotRange->{-1, 1}, Frames->24]

MovieParametricPlot[ {Sin[x t], Cos[x t]}, {x, -Pi, Pi}, {t, 0, 1, 1/11},
	PlotRange->{{-1, 1}, {-1, 1}}, AspectRatio->1 ]

graphics = Plot3D[ Sin[x y],{x,-2,2},{y,-2,2}, Axes->None, Boxed->False];
SpinShow[ graphics ]

*)
