home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / SURFACEO.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  4.4 KB  |  145 lines
  1. (* :Title: Surface of Revolution of Curves *)
  2.  
  3. (* :Context: Graphics`SurfaceOfRevolution` *)
  4.  
  5. (* :Author: John M. Novak *)
  6.  
  7. (* :Summary: Plots surfaces of revolution of curves, specified
  8.     as a function or parametrically, or as a list of points.
  9.     Rotation can be about arbitrary axis. *)
  10.  
  11. (* :Package Version: 2.0 *)
  12.  
  13. (* :Mathematica Version: 2.0 *)
  14.  
  15. (* :History:
  16.     V1.0 by Kevin McIsaac, Nov. 1990
  17.     Extensively modified by John M. Novak, April 1991
  18.     V2.0, Complete rewrite, John M. Novak, Feb. 1992
  19. *)
  20.  
  21. (* :Keywords:
  22.     Surface of Revolution, Curve
  23. *)
  24.  
  25. (* :Sources:
  26.     Rogers, David F. and Adams, J. Alan, Mathematical Elements for
  27.         Computer Graphics, McGraw-Hill, 1976
  28. *)
  29.  
  30. BeginPackage["Graphics`SurfaceOfRevolution`",
  31.     "Utilities`FilterOptions`"];
  32.  
  33. SurfaceOfRevolution::usage =
  34. "SurfaceOfRevolution[fun, {u,u0,u1}, (options..)]
  35. plots the surface of revolution of the curve defined by
  36. the function fun (the dependent variable is in the z plane).
  37. SurfaceOfRevolution[{x-fun,z-fun},{u,u0,u1},(opts...)]
  38. plots the surface of revolution of the curve defined 
  39. parametrically by {x-fun,z-fun}.
  40. SurfaceOfRevolution[{x-fun, y-fun, z-fun}, {u, u0, u1}] is also
  41. allowed. Also, the range of revolution can be specified after the
  42. range of the variable u by {t,tmin,tmax}.  Accepts option 
  43. specifying Axis, along with ParametricPlot3D options.";
  44.  
  45. ListSurfaceOfRevolution::usage =
  46. "ListSurfaceOfRevolution[pts,({t, tmin, tmax})] will generate
  47. a rotated surface from the list of points pts (either pairs in
  48. the x-z plane, or triplets in space), with the variable of
  49. rotation being t, ranging from tmin to tmax.  (If not used,
  50. the rotation will be all the way around the axis.) Accepts
  51. option specifying Axis, along with Graphics3D options.";
  52.  
  53. Axis::usage =
  54. "Axis is an option for the SurfaceOfRevolution functions.  It
  55. is either a pair (representing an axis in the x-z plane) or
  56. a triplet (representing an axis in space.)  Default is
  57. {0,0,1} (the z-axis).";
  58.  
  59. Begin["`Private`"]
  60.  
  61. Options[SurfaceOfRevolution] =
  62.     {Axis -> {0,0,1}};
  63.  
  64. SurfaceOfRevolution[func_?(Head[#] =!= List &),
  65.         range:{x_Symbol, _, _},rest___] :=
  66.     SurfaceOfRevolution[{x,0,func},range,rest]
  67.  
  68. SurfaceOfRevolution[{x_, z_}, rest___] :=
  69.     SurfaceOfRevolution[{x, 0, z}, rest]
  70.  
  71. SurfaceOfRevolution[{x_,y_,z_},
  72.         vrange:{_Symbol, _?(NumberQ[N[#]]&), _?(NumberQ[N[#]]&)},
  73.         Optional[trange:{t_Symbol, _?(NumberQ[N[#]]&), _?(NumberQ[N[#]]&)},
  74.             {Unique[],0,2 Pi}],
  75.         opts:(Rule_ | RuleDelayed_)...] :=
  76.     ParametricPlot3D[Evaluate[
  77.         {x,y,z} . rotationmatrix[Axis/.{opts}/.
  78.                 Options[SurfaceOfRevolution],
  79.             t]],
  80.         vrange, trange,
  81.         Evaluate[FilterOptions[ParametricPlot3D,opts]]
  82.     ]
  83.  
  84. Options[ListSurfaceOfRevolution] =
  85.     {PlotPoints -> 15,
  86.     Axis -> {0,0,1}};
  87.  
  88. ListSurfaceOfRevolution[
  89.         pts_?(MatrixQ[N[#],NumberQ] &)/;Last[Dimensions[pts]] === 2,
  90.         rest___] :=
  91.     ListSurfaceOfRevolution[
  92.         Map[{First[#],0,Last[#]}&,pts],
  93.         rest]
  94.  
  95. ListSurfaceOfRevolution[
  96.         pts_?(MatrixQ[N[#],NumberQ] &)/;Last[Dimensions[pts]] === 3,
  97.         Optional[trange:{t_Symbol, min_?(NumberQ[N[#]]&), max_?(NumberQ[N[#]]&)},
  98.             {Unique[],0,2 Pi}],
  99.         opts:(Rule_ | RuleDelayed_)...] :=
  100.     Module[{pp, axis, array, rmatrix},
  101.         {pp, axis} = {PlotPoints, Axis}/.{opts}/.
  102.             Options[ListSurfaceOfRevolution];
  103.         listsurfaceplot[Table[rmatrix = rotationmatrix[axis,t];
  104.                 Map[# . rmatrix &, pts],
  105.                 {t, min, max, (max - min)/(pp - 1)}],
  106.             FilterOptions[Graphics3D,opts],
  107.             Axes -> True
  108.         ]
  109.     ]
  110.         
  111.  
  112. rotationmatrix[{a_,b_}, theta_] :=
  113.     rotationmatrix[{a,0,b},theta]
  114.  
  115. rotationmatrix[axis_,theta_] :=
  116.     Module[{n1,n2,n3},
  117.         {n1,n2,n3} = axis/Sqrt[Plus @@ (axis^2)]//N;
  118.         {{n1^2 + (1 - n1^2) Cos[theta],
  119.             n1 n2 (1 - Cos[theta]) + n3 Sin[theta],
  120.             n1 n3 (1 - Cos[theta]) - n2 Sin[theta]},
  121.         {n1 n2 (1 - Cos[theta]) - n3 Sin[theta],
  122.             n2^2 + (1 - n2^2) Cos[theta],
  123.             n2 n3 (1 - Cos[theta]) + n1 Sin[theta]},
  124.         {n1 n3 (1 - Cos[theta]) + n2 Sin[theta],
  125.             n2 n3 (1 - Cos[theta]) - n1 Sin[theta],
  126.             n3^2 + (1 - n3^2) Cos[theta]}}//N
  127.     ]
  128.  
  129. (* What follows is a modified version of
  130.     ListSurfacePlot3D from Graphics3D.m *)
  131.  
  132. listsurfaceplot[vl_,opts___] :=
  133.     Module[{l = vl, l1 = Map[RotateLeft, vl], mesh},
  134.         mesh = {l, l1, RotateLeft[l1], RotateLeft[l]};
  135.         mesh = Map[Drop[#, -1]&, mesh, {1}];
  136.         mesh = Map[Drop[#, -1]&, mesh, {2}];
  137.         Show[Graphics3D[
  138.             Polygon /@ Transpose[ Map[Flatten[#, 1]&, mesh] ]],
  139.             opts]
  140.     ]
  141.  
  142. End[]
  143.  
  144. EndPackage[]
  145.