home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / ANIMATIO.M next >
Encoding:
Text File  |  1992-07-29  |  12.2 KB  |  337 lines
  1.  
  2. (* Copyright 1989, 1990 Wolfram Research, Inc. *)
  3.  
  4. (*:Version: Mathematica 2.0 *)
  5.  
  6. (*:Title: Control Functions for Animation *)
  7.  
  8. (*:Author:
  9.     R. Maeder, after a version by Theodore Gray and David Ballman
  10. *)
  11.  
  12. (*:Keywords:
  13.     Animation, Movie, Animate
  14. *)
  15.  
  16. (*:Requirements: Machine-dependent animation capabilities.  If such
  17. are available, the machine-specific definitions for rendering
  18. animations will be set up in the graphics initialization files, such
  19. as X11.ps *)
  20.  
  21. (*:Sources: none. *)
  22.  
  23. (*:Summary:  This file contains various animation functions for
  24. regular x-y, density, contour, and parametric curve plots.  Animation
  25. of three-dimensional plots and rotation of two-dimensional plots
  26. is also supported.
  27. *)
  28.  
  29.  
  30. BeginPackage["Graphics`Animation`", "Geometry`Rotations`"]
  31.  
  32. Animation::usage = "Graphics/Animation.m contains various animation functions.
  33.     Options used are: RasterFunction, AnimationFunction, Frames, and Closed.
  34.     They pass any extra options to the embedded Show[] command to render
  35.     the frames."
  36.  
  37. ShowAnimation::usage = "ShowAnimation[{g,h,...}, options...] produces
  38.     an animation from a sequence of graphics objects."
  39.  
  40. System`DisplayAnimation::usage = "DisplayAnimation[file, glist] writes the
  41.     PostScript code of all frames in the list of graphics glist to file.
  42.     The frames are separated by cell header lines. file can be animated
  43.     under the Notebook front end or in most PostScript renderers supplied
  44.     with Mathematica."
  45.  
  46. Animate::usage = "Animate[command, iterator, options...] uses the
  47.     iterator to run the specified graphics command,
  48.     and animates the results."
  49.  
  50. MoviePlot::usage = "MoviePlot[f[x,t], {x,x0,x1}, {t,t0,t1}, options...] will
  51.     animate plots of f[x,t] regarded as a function of x, with t serving as
  52.     the animation (or time) variable."
  53.  
  54. MoviePlot3D::usage = "MoviePlot3D[f[x,y,t], {x,x0,x1}, {y,y0,y1}, {t,t0,t1},
  55.     options...] will animate x,y-plots of the given function by varying t."
  56.  
  57. MovieDensityPlot::usage = "MovieDensityPlot[f[x,y,t], {x,x0,x1}, {y,y0,y1},
  58.     {t,t0,t1}, options...] will animate x,y-density-plots of the given
  59.     function by varying t."
  60.  
  61. MovieContourPlot::usage = "MovieContourPlot[f[x,y,t], {x,x0,x1}, {y,y0,y1},
  62.     {t,t0,t1}, options...] will animate x,y-contour-plots of the given
  63.     function by varying t."
  64.  
  65. MovieParametricPlot::usage = "MovieParametricPlot[{f[x,t],g{x,t}}, {x,x0,x1},
  66.     {t,t0,t1}, options...] will animate parametric curve plots of the given
  67.     function by varying t."
  68.  
  69. SpinShow::usage = "SpinShow[graphics, opts...]
  70.     will animate a three-dimensional graphics object by rotating it."
  71.  
  72. RasterFunction::usage = "RasterFunction is an option of ShowAnimation[]
  73. that specifies the function to use to rasterize the individual
  74. frames in an animation.  It is also used by Animate[], MoviePlot[],
  75. SpinShow[], etc."
  76.  
  77. AnimationFunction::usage = "AnimationFunction is an option of ShowAnimation[]
  78.     that specifies the function to use to show the animation.
  79.     It is also used by Animate[], MoviePlot[], SpinShow[], etc."
  80.  
  81. Frames::usage = "Frames is an option of Animate[] and SpinShow[] that specifies
  82.     number of frames to render, if the animation iterator does not
  83.     specify an increment."
  84.  
  85. Closed::usage = "Closed -> False/True is an option of Animate[]
  86. and SpinShow[] that specifies whether the last value of the animation
  87. iterator is assumed to give the same picture as the first one. If
  88. True, the last frame is not rendered. For example, {t, 0, 2Pi},
  89. Closed->True, Frames -> 24 will generate frames for t = 0, 2Pi/24,...,
  90. 2Pi - 2Pi/24."
  91.  
  92. Options[ ShowAnimation ] = {
  93.     RasterFunction :> System`$RasterFunction,
  94.     AnimationFunction :> System`$AnimationFunction
  95.     }
  96.  
  97. Options[ Animate ] = {
  98.     Frames -> 24,
  99.     Closed -> False
  100.     }
  101.  
  102. Options[SpinShow] = {
  103.     Frames -> 24,
  104.     Closed -> True,
  105.     SpinOrigin -> {0,0,1.5},
  106.     SpinTilt -> {0,0},
  107.     SpinDistance -> 2,
  108.     SpinRange -> {0 Degree, 360 Degree},
  109.     RotateLights -> False
  110.     }
  111.  
  112.  
  113. Begin["`Private`"]
  114.  
  115. (* Here is how it works:
  116.  *
  117.  * For each frame, Show[ -graphics-, DisplayFunction -> $RasterFunction ]
  118.  * is called. The results are saved in a list.
  119.  * At the end, $AnimationFunction[ list ] is called.
  120.  * Normally the idea is that $RasterFunction leaves a raster (or other)
  121.  * image of the current frame in a file named filename.
  122.  * $AnimationFunction then calls an external program to do the animation.
  123.  * Alternatively, $RasterFunction can be Identity, collecting
  124.  * the graphics themselves in the list.
  125.  *
  126.  * The values of these two functions should be set in
  127.  * the device-dependent graphics initialization file.
  128.  *
  129.  * The defaults below concatenate the PostScript code of all frames
  130.  * with the appropriate header information and write it to the file argument
  131.  * of the default DisplayFunction--if this is indeed Display[].
  132.  * This default is appropriate for the graphics renderers supplied
  133.  * by Wolfram Research and for front end versions.
  134.  *
  135.  * With these values, the combined PostScript code of an animation can be saved
  136.  * in the file file.anim with the command
  137.  *
  138.  *     ShowAnimation[glist, DisplayFunction->(Display["file.anim", #]&)]
  139.  * or
  140.  *     Animate[cmd, range, DisplayFunction->(Display["file.anim", #]&)]
  141.  *
  142.  * Independent of the machine-dependent setting, the following can be used:
  143.  *
  144.  *    DisplayAnimation["file.anim", glist]
  145.  *
  146.  *)
  147.  
  148. (* defaults for $RasterFunction and $AnimationFunction
  149.    in case the graphics init file did not define them *)
  150.  
  151. If[ !ValueQ[System`$RasterFunction],
  152.     $RasterFunction = Identity ]
  153. If[ !ValueQ[System`$AnimationFunction],
  154.     $AnimationFunction = System`DisplayAnimation ]
  155.  
  156. (* examine $DisplayFunction: is it Display[file, #]& ? *)
  157.  
  158. System`DisplayAnimation[pics_List] :=
  159.     Module[{display},
  160.         If[ Head[$DisplayFunction] === Function &&
  161.             HeldPart[$DisplayFunction, -1, 0] === Hold[Display],
  162.           display = HeldPart[$DisplayFunction, -1, 1][[1]];
  163.           DisplayAnimation[display, pics];
  164.           pics,
  165.         (* else: show all frames *)
  166.           Show[#, DisplayFunction -> $DisplayFunction]& /@ pics
  167.         ]
  168.     ]
  169.  
  170. DisplayAnimation[disp_List, pics_] := DisplayAnimation[#, pics]& /@ disp
  171.  
  172. DisplayAnimation[display_, pics_] :=
  173.     Module[{stream, nopen},
  174.         stream = Streams[ display];
  175.         nopen = (stream === {});
  176.         If[nopen, stream = OpenWrite[ display]];
  177.         If[ stream === $Failed, Return[stream]];
  178.         WriteFrame[stream, #]& /@ pics;
  179.         If[ nopen, Close[stream]];
  180.         pics
  181.     ]
  182.  
  183. (* header line for animation cells *)
  184.  
  185. $AnimationCellString = ":[font = postscript; inactive; PostScript; output; preserveAspect; ]\n"
  186.  
  187. WriteFrame[stream_, pic_] := (
  188.     WriteString[stream, $AnimationCellString];
  189.     Display[stream, pic];
  190. )
  191.  
  192. (* end of defaults section *)
  193.  
  194. FilterOptions[ command_Symbol, opts___ ] :=
  195.     Module[{keywords = First /@ Options[command]},
  196.         Sequence @@ Select[ {opts}, MemberQ[keywords, First[#]]& ]
  197.     ]
  198.  
  199. Pixelize[ go_, RasterFunction_, opts___ ] :=
  200.     Module[ {gtype = Head[go]},
  201.         While[ gtype === List && Length[gtype] > 0,
  202.                gtype = Head[gtype] ];
  203.         Show[ go, DisplayFunction -> RasterFunction,
  204.                   FilterOptions[gtype, opts] ]
  205.     ]
  206.  
  207.  
  208. ShowAnimation[ gl_List, opts___ ] :=
  209.     Module[{filelist, rasterFunction, animationFunction, SaveDisplay},
  210.         rasterFunction = RasterFunction /. {opts} /. Options[ShowAnimation];
  211.         animationFunction = AnimationFunction /. {opts} /. Options[ShowAnimation];
  212.         SaveDisplay = DisplayFunction /. {opts} /. {DisplayFunction -> $DisplayFunction};
  213.         filelist = Pixelize[#, rasterFunction, opts]& /@ gl;
  214.         Block[{$DisplayFunction = SaveDisplay},
  215.           animationFunction[ filelist ]
  216.         ]
  217.     ]
  218.  
  219. Attributes[Animate] = {HoldFirst};
  220. Animate[ function_, {t_, t0_, t1_, dt_:Automatic}, opts___ ] :=
  221.     Module[{filelist, rasterFunction, animationFunction, SaveDisplay,
  222.            ndt = dt, closed, nt1 = t1, frames},
  223.         closed = Closed /. {opts} /. Options[Animate];
  224.         rasterFunction = RasterFunction /. {opts} /. Options[ShowAnimation];
  225.         animationFunction = AnimationFunction /. {opts} /. Options[ShowAnimation];
  226.         SaveDisplay = DisplayFunction /. {opts} /. {DisplayFunction -> $DisplayFunction};
  227.         If[ dt === Automatic,
  228.             frames = Frames-1 /. {opts} /. Options[Animate];
  229.             If[ closed, frames++ ];
  230.             ndt = (t1 - t0)/frames ];
  231.         If[ closed, nt1 -= ndt];
  232.         Block[{$DisplayFunction = Identity,
  233.                $SoundDisplayFunction = Identity},
  234.           filelist = Table[ Pixelize[function, rasterFunction, opts],
  235.                       {t, t0, nt1, ndt} ]
  236.         ];
  237.         Block[{$DisplayFunction = SaveDisplay},
  238.           animationFunction[ filelist ]
  239.         ]
  240.     ]
  241.  
  242. (* the following borrow their options from Animate[] *)
  243.  
  244. Attributes[MoviePlot] = {HoldFirst};
  245. MoviePlot[ function_, xRange_List, animationRange_List, opts___ ] := 
  246.     Animate[ Plot[function, xRange, DisplayFunction->Identity,
  247.                 Evaluate[FilterOptions[Plot, opts]]], 
  248.            animationRange, FilterOptions[Animate, opts] ];
  249.  
  250. Attributes[MoviePlot3D] = {HoldFirst};
  251. MoviePlot3D[ function_, xRange_List, yRange_List, animationRange_List, opts___ ] := 
  252.     Animate[ Plot3D[function, xRange, yRange, DisplayFunction->Identity,
  253.                 Evaluate[FilterOptions[Plot3D, opts]]], 
  254.            animationRange, FilterOptions[Animate, opts] ];
  255.  
  256. Attributes[MovieDensityPlot] = {HoldFirst};
  257. MovieDensityPlot[function_, xRange_List, yRange_List, animationRange_List, opts___ ] :=
  258.     Animate[ DensityPlot[function, xRange, yRange, DisplayFunction->Identity,
  259.                 Evaluate[FilterOptions[DensityPlot, opts]]], 
  260.            animationRange, FilterOptions[Animate, opts] ];
  261.  
  262. Attributes[MovieContourPlot] = {HoldFirst};
  263. MovieContourPlot[ function_, xRange_List, yRange_List, animationRange_List, opts___ ] := 
  264.     Animate[ ContourPlot[function, xRange, yRange, DisplayFunction->Identity,
  265.                 Evaluate[FilterOptions[ContourPlot, opts]]], 
  266.            animationRange, FilterOptions[Animate, opts] ];
  267.  
  268. Attributes[MovieParametricPlot] = {HoldFirst};
  269. MovieParametricPlot[ function_, xRange_List, animationRange_List, opts___ ] := 
  270.     Animate[ ParametricPlot[function, xRange, DisplayFunction->Identity,
  271.                 Evaluate[FilterOptions[ParametricPlot, opts]]], 
  272.            animationRange, FilterOptions[Animate, opts] ];
  273.  
  274. SpinShow[theGraphic_, options___] :=
  275.     Module[{ spinOrigin = SpinOrigin /. {options} /. Options[SpinShow],
  276.         spinTilt = SpinTilt /. {options} /. Options[SpinShow],
  277.         spinDistance = SpinDistance /. {options} /. Options[SpinShow],
  278.         spinRange = SpinRange //. {options} //. Options[SpinShow],
  279.         lightSources = LightSources /. {options} /.
  280.                 Flatten[Options[theGraphic]] /. Options[Head[theGraphic]],
  281.         rotateLights = RotateLights /. {options} /. Options[SpinShow],
  282.         closed = Closed /. {options} /. Options[SpinShow],
  283.         frames = Frames /. {options} /. Options[SpinShow],
  284.         thetaFactor, phiFactor, rhoFactor, theta },
  285.     
  286.     thetaFactor = Switch[rotateLights,  False, 0, 
  287.                                         True, 1,
  288.                                         Opposite, -1,
  289.                                         _, 0];
  290.     phiFactor = If[rotateLights, 1, 0, 0];
  291.     rhoFactor = If[rotateLights, 1, 0, 0];
  292.     
  293.     Animate[ Show[theGraphic, DisplayFunction -> Identity,
  294.             ViewPoint->(spinOrigin +
  295.              spinDistance Rotate3D[{1,0,0}, theta, spinTilt[[1]], spinTilt[[2]]]),
  296.             LightSources ->  Map[{Rotate3D[#[[1]], 
  297.                     thetaFactor theta,
  298.                     phiFactor spinTilt[[1]],
  299.                     rhoFactor spinTilt[[2]]], #[[2]]}&, 
  300.                     lightSources],
  301.                 FilterOptions[Head[theGraphic], options],
  302.                 SphericalRegion -> True],
  303.            {theta, spinRange[[1]], spinRange[[2]]},
  304.            Closed -> closed, Frames -> frames
  305.         ]
  306.     ]
  307.  
  308. End[]   (* Graphics`Animation`Private` *)
  309.  
  310. Protect[ShowAnimation, Animate, DisplayAnimation, MoviePlot, MoviePlot3D,
  311.     MovieDensityPlot, MovieContourPlot, MovieParametricPlot, SpinShow,
  312.     Frames, Closed, RasterFunction, AnimationFunction, SpinOrigin,
  313.     SpinTilt, SpinDistance, SpinRange, RotateLights]
  314.  
  315. EndPackage[]   (* Graphics`Animation` *)
  316.  
  317. (*:Limitations: none known. *)
  318.  
  319. (*:Tests:
  320.  
  321. *)
  322.  
  323. (*:Examples:
  324. Animate[ Plot[ Sin[x t], {x,-3,3}, PlotRange->{-1, 1} ], {t,0,1} ]
  325.  
  326. MoviePlot[ Sin[x t], {x,-5,5}, {t,0,1}, PlotRange->{-1, 1} ]
  327.  
  328. MoviePlot3D[ Sin[ x y t], {x,-2,2}, {y,-2,2}, {t,0,1}, PlotRange->{-1, 1}, Frames->24]
  329.  
  330. MovieParametricPlot[ {Sin[x t], Cos[x t]}, {x, -Pi, Pi}, {t, 0, 1, 1/11},
  331.     PlotRange->{{-1, 1}, {-1, 1}}, AspectRatio->1 ]
  332.  
  333. graphics = Plot3D[ Sin[x y],{x,-2,2},{y,-2,2}, Axes->None, Boxed->False];
  334. SpinShow[ graphics ]
  335.  
  336. *)
  337.