home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / SHAPES.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  7.0 KB  |  230 lines
  1.  
  2. (* Copyright 1989, 1990 Wolfram Research Inc. *)
  3.  
  4. (*:Version: Mathematica 2.0 *)
  5.  
  6. (*:Title: Shapes of Common 3D Solids *)
  7.  
  8. (*:Author: Roman Maeder *)
  9.  
  10. (*:Keywords:
  11.     Shapes, cylinder, cone, torus, sphere, MoebiusStrip,
  12.     helix, DoubleHelix, wireframe
  13. *)
  14.  
  15. (*:Requirements: none. *)
  16.  
  17. (*:Warnings: none. *)
  18.  
  19. (*:Sources:
  20.     Roman E. Maeder: Programming in Mathematica, 2nd Ed.,
  21.     Addison-Wesley, 1991.
  22. *)
  23.  
  24. (*:Summary:
  25. *)
  26.  
  27.  
  28. BeginPackage["Graphics`Shapes`", "Geometry`Rotations`"]
  29.  
  30.  
  31. Shapes::usage = "<<Graphics/Shapes.m defines functions for creating and
  32.     manipulating graphic representations of various geometric objects."
  33.  
  34. Cylinder::usage = "Cylinder[(r:1, h:1, (n:20r))] is a list of n polygons
  35.     approximating an open cylinder centered around the z-axis with
  36.     radius r and half height h."
  37.  
  38. Cone::usage = "Cone[(r:1, h:1, (n:20r))] is a list of n polygons
  39.     approximating a cone centered around the z-axis with
  40.     radius r and extending from -h to h."
  41.  
  42. Torus::usage = "Torus[(r1:1, r2:0.5, (n:20r1, m:20r2))] is a list of n*m
  43.     polygons approximating a torus centered around the z-axis with
  44.     radii r1 and r2."
  45.  
  46. Sphere::usage = "Sphere[(r:1, (n:20r, m:15r))] is a list of n*(m-2)+2
  47.     polygons approximating a sphere with radius r."
  48.  
  49. MoebiusStrip::usage = "MoebiusStrip[(r1:1, r2:0.5, (n:20r1))] is a list
  50.     of 2n polygons approximating a moebius strip centered around
  51.     the z-axis with radii r1 and r2."
  52.  
  53. Helix::usage = "Helix[(r:1, h:0.5, (m:2, n:20r))] is a list of n*m polygons
  54.     approximating a helix with half height h and m turns."
  55.  
  56. DoubleHelix::usage = "DoubleHelix[(r:1, h:0.5, (m:2, n:20r))] is a list
  57.     of n*m polygons approximating a double helix with half height h
  58.     and m turns."
  59.  
  60. RotateShape::usage = "RotateShape[-Graphics3D-, phi, theta, psi] rotates
  61.     the graphics object by the specified Euler angles."
  62.  
  63. TranslateShape::usage = "TranslateShape[-Graphics3D-, {x, y, z}] translates
  64.     the graphics object by the specified vector."
  65.  
  66. AffineShape::usage = "AffineShape[-Graphics3D-, {x, y, z}] multiplies
  67.     all coordinates by x, y, and z respectively."
  68.  
  69. WireFrame::usage = "WireFrame[-Graphics3D-] replaces all
  70.     polygons in -Graphics3D- by outlines."
  71.  
  72. Begin["`Private`"]
  73.  
  74. MakeShape[vl_List, c1_Integer, c2_Integer] :=
  75.     Block[{l = vl,
  76.            l1 = RotateLeft /@ vl,
  77.            mesh},
  78.     mesh = {l, l1, RotateLeft[l1], RotateLeft[l]};
  79.     If[c1 == 1, mesh = Map[Drop[#, -1]&, mesh, {1}] ];
  80.     If[c2 == 1, mesh = Map[Drop[#, -1]&, mesh, {2}] ];
  81.     (*Graphics3D[*) Polygon /@ Transpose[ Map[Flatten[#, 1]&, mesh] ] (*]*)
  82.     ]                    /; TensorRank[vl] >= 2
  83. (* c1 = 0 closes the surface in the first dimension, c1 = 1 leaves it open
  84.    and analogous for the second dimension *)
  85.  
  86. Cylinder[r_, h_, n_Integer] :=
  87.     MakeShape[
  88.     Block[{rcphi, rsphi},
  89.         Table[rcphi = N[r Cos[2Pi i/n]]; rsphi = N[r Sin[2Pi i/n]];
  90.           {{rcphi, rsphi, h}, {rcphi, rsphi, -h}}, {i,n}] ],
  91.     0, 1]                        /; n>2
  92. Cylinder[r_:1, h_:1] := Cylinder[r, h, Round[20r]]
  93.  
  94. Cone[r_, h_, n_Integer] :=
  95.     (*Graphics3D[*)N[Table[Polygon[{{r Cos[2Pi i/n], r Sin[2Pi i/n], -h},
  96.              {r Cos[2Pi (i+1)/n], r Sin[2Pi (i+1)/n], -h},
  97.              {0, 0, h}}], {i, 0, n-1}]](*]*)/; n > 2
  98. Cone[r_:1, h_:1] := Cone[r, h, Round[20r]]
  99.  
  100. Torus[r1_, r2_, n_Integer, m_Integer] :=
  101.     MakeShape[
  102.     Block[{cphi, sphi, s},
  103.         Table[cphi = N[Cos[2Pi i/n]]; sphi = N[Sin[2Pi i/n]];
  104.           Table[s = N[r1 + r2 Cos[2Pi j/m]];
  105.             {cphi s, sphi s, N[r2 Sin[2Pi j/m]]},
  106.                {j, m}],
  107.              {i, n}]],
  108.     0, 0]                        /; n>2 && m>2
  109. Torus[r1_:1.0, r2_:0.5] := Torus[r1, r2, Round[20r1], Round[20r2]]
  110.  
  111. Sphere[r_, n_Integer, m_Integer] :=
  112.     (*Graphics3D[Join[#[[1]], #[[2]]]]& [*)
  113.     MakeShape[
  114.     Block[{cphi, sphi, s},
  115.       Table[cphi = N[Cos[2Pi i/n]]; sphi = N[Sin[2Pi i/n]];
  116.         Table[s = N[r Cos[-Pi/2+ Pi j/m]];
  117.               {cphi s, sphi s, N[r Sin[-Pi/2 + Pi j/m]]},
  118.              {j, 1, m-1}],
  119.            {i, 0, n-1}]],
  120.     0, 1] ~Join~    (* pole patches *)
  121.     Block[{s = N[r Cos[-Pi/2 + Pi/m]], z = N[r Sin[-Pi/2 + Pi/m]]},
  122.     (*Graphics3D[*){Polygon[Table[{N[s Cos[2Pi i/n]],
  123.             N[s Sin[2Pi i/n]],
  124.             z},
  125.               {i, 0, n-1}]],
  126.              z=-z;
  127.             Polygon[Table[{N[s Cos[2Pi i/n]],
  128.              N[s Sin[2Pi i/n]],
  129.              z},
  130.                {i, n-1, 0, -1}]]
  131.     }(*]*)
  132.     ](*]*)                /; n>2 && m>2
  133. Sphere[r_:1.0] := Sphere[r, Round[20r], Round[15r]]
  134.  
  135. MoebiusStrip::notes = "We go around it twice, so that shading comes out right."
  136. MoebiusStrip[r1_, r2_, n_Integer] :=
  137.     MakeShape[
  138.     Block[{cphi, sphi, h, rs},
  139.       Table[rs = N[r2 Cos[Pi i/n]]; h = N[r2 Sin[Pi i/n]];
  140.             cphi = N[Cos[2Pi i/n]]; sphi = N[Sin[2Pi i/n]];
  141.         {{(r1 + rs) cphi, (r1 + rs) sphi,  h},
  142.          {(r1 - rs) cphi, (r1 - rs) sphi, -h}},
  143.            {i,0,2n-1}]],
  144.     0, 1]                            /; n>2
  145. MoebiusStrip[r1_:1.0, r2_:0.5] := MoebiusStrip[r1, r2, Round[20r1]]
  146.  
  147. Helix[r_, h_, m_, n_] :=
  148.     MakeShape[
  149.         Block[{in, pin, hh = N[2h/m]},
  150.       Table[in = N[i/n]; pin = N[2Pi in];
  151.             {{0, 0, hh in}, {r Cos[pin], r Sin[pin], hh in}},
  152.            {i, -n m / 2, n m / 2}]],
  153.     1, 1]
  154. Helix[r_:1.0, h_:1.0, m_:2] := Helix[r, h, m, Round[20r]]
  155.  
  156. DoubleHelix[r_, h_, m_, n_] :=
  157.     MakeShape[
  158.         Block[{rc, rs, ih, hh = N[2h/m]},
  159.       Table[rc = N[r Cos[2Pi i/n]]; rs = N[r Sin[2Pi i/n]]; ih = hh i/n;
  160.         {{-rc, -rs, ih}, {0, 0, ih}, {rc, rs, ih}},
  161.            {i, -n m / 2, n m / 2}]],
  162.     1, 1]
  163. DoubleHelix[r_:1.0, h_:1.0, m_:2] := DoubleHelix[r, h, m, Round[20r]]
  164.  
  165. RotateShape[ shape_, phi_, theta_, psi_ ] :=
  166.     Block[{rotmat = RotationMatrix3D[N[phi], N[theta], N[psi]]},
  167.     shape /. { poly:Polygon[_] :> Map[(rotmat . #)&, poly, {2}],
  168.            line:Line[_]    :> Map[(rotmat . #)&, line, {2}],
  169.            point:Point[_]  :> Map[(rotmat . #)&, point,{1}] }
  170.     ]
  171.  
  172. TranslateShape[shape_, vec_List] :=
  173.     Block[{tvec = N[vec]},
  174.     shape /. { poly:Polygon[_] :> Map[(tvec + #)&, poly, {2}],
  175.            line:Line[_]    :> Map[(tvec + #)&, line, {2}],
  176.            point:Point[_]  :> Map[(tvec + #)&, point,{1}] }
  177.     ] /; Length[vec] == 3
  178.  
  179.  
  180. AffineShape[ shape_, vec_List ] :=
  181.     Block[{tvec = N[vec]},
  182.     shape /. { poly:Polygon[_] :> Map[(tvec * #)&, poly, {2}],
  183.            line:Line[_]    :> Map[(tvec * #)&, line, {2}],
  184.            point:Point[_]  :> Map[(tvec * #)&, point,{1}] }
  185.     ] /; Length[vec] == 3
  186.  
  187.  
  188. WireFrame[shape_] := shape /. Polygon[x_] :> Line[ Append[x, First[x]] ]
  189.  
  190.  
  191. End[]   (* Graphics`Shapes`Private` *)
  192.  
  193. Protect[Cylinder, Cone, Torus, Sphere, MoebiusStrip, Helix, DoubleHelix,
  194.     RotateShape, TranslateShape, AffineShape, WireFrame]
  195.  
  196. EndPackage[]   (* Graphics`Shapes` *)
  197.  
  198. (*:Limitations:
  199. *)
  200.  
  201. (*:Tests:
  202. *)
  203.  
  204. (*:Examples:
  205.  
  206. Show[ Graphics3D[ Cylinder[ 0.5,0.5]]]
  207.  
  208. Show[ Graphics3D[ Cone[]]]
  209.  
  210. Show[ Graphics3D[ Torus[2,0.7,15,14]]]
  211.  
  212. Show[ Graphics3D[Sphere[]]]
  213.  
  214. Show[ Graphics3D[ MoebiusStrip[ 2,1,80]]]
  215.  
  216. Show[ Graphics3D[ Helix[] ] ]
  217.  
  218. Show[ Graphics3D[ DoubleHelix[] ] ]
  219.  
  220. Show[ RotateShape[ Graphics3D[ MoebiusStrip[] ], Pi/4, Pi/3, Pi/2 ] ]
  221.  
  222. Show[ TranslateShape[ RotateShape[ Graphics3D[ MoebiusStrip[] ], Pi/4, Pi/3,
  223.    Pi/2 ], {2,3,4}] ]
  224.  
  225. Show[ AffineShape[ Graphics3D[ Cone[] ],{1,2,3} ] ]
  226.  
  227. Show[ WireFrame[ Graphics3D[ Cone[] ] ] ]
  228.  
  229. *)
  230.