home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / SPLINE.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  6.8 KB  |  224 lines
  1.  
  2. (* :Title: Spline *)
  3.  
  4. (* :Author: John M. Novak *)
  5.  
  6. (* :Summary:  Introduces a Spline graphic object and
  7.     a function for generating these objects, as well as
  8.     utilities for rendering them. *)
  9.     
  10. (* :Context: Graphics`Spline` *)
  11.  
  12. (* :Package Version: 1.1 *)
  13.  
  14. (* :History: V1.0 by John M. Novak, Dec. 1990 *)
  15.  
  16. (* :Keywords: splines, curve fitting, graphics *)
  17.  
  18. (* :Sources:
  19.     Bartels, Beatty, and Barsky: "An Introduction to
  20.         Splines for Use in Computer Graphics and
  21.         Geometric Modelling", Morgan Kaufmann, 1987.
  22.     de Boor, Carl: "A Practical Guide to Splines",
  23.         Springer-Verlag, 1978.
  24.     Levy, Silvio: Bezier.m: A Mathematica Package for
  25.         Bezier Splines, Dec. 1990.
  26. *)
  27.  
  28. (* :Warning: adds definitions to the function Display. *)
  29.  
  30. (* :Mathematica Version: 2.0 *)
  31.  
  32. (* :Limitation: does not currently handle 3D splines, although
  33.     some spline primitives may produce a curve in space. *)
  34.  
  35. BeginPackage["Graphics`Spline`"]
  36.  
  37. Spline::usage = "Spline[points,type] represents a spline object of
  38. kind type through (or controlled by) points.  It produces a spline
  39. graphics primitive of the form Spline[points,type,control]. control
  40. is information relevant to the particular kind of spline, describing
  41. it completely.";
  42.     
  43. Cubic::usage = "
  44. Cubis is a type of spline, which is used in Spline[].  Default
  45. description sets second derivative at endpoints = 0 and unit
  46. parameter spacing between knots.";
  47.  
  48. CompositeBezier::usage = "
  49. CompositeBezier is a type of spline, which is used in Spline[].
  50. Default description uses unit parameter spacing between sets of
  51. vertices.  This is set to have C1 continuity between joins; thus,
  52. in general, every other point is an interpolating control vertex,
  53. from the first point.  Each segment is defined by four vertices,
  54. the first and last being interpolated, the second being given, and
  55. the third being determined by the continuity condition and derived from
  56. the following noninterpolated control vertex.  Note that this
  57. fails at the end;  here, if the number of points given is even,
  58. then the last two points are reversed so that the final point is
  59. interpolated and the next to last is a control point for the final
  60. segment; if odd, then the final vertex is doubled.";
  61.  
  62. Bezier::usage = " 
  63. Bezier is a type of spline, which is used in Spline[]. In generating,
  64. given n points, it creates a spline of degree n-1.  The spline has
  65. unit parameter spacing."
  66.  
  67. SplinePoints::usage = "
  68. SplinePoints is an option for Spline, which determines number of
  69. points of interpolation between each control point of a spline.
  70. Default is $SplinePoints.";
  71.  
  72. SplineDots::usage = "
  73. SplineDots is an option for Spline that specifies a style for a point.
  74. SplineDots=None specifies that nothing should appear at each control
  75. point.  SplineDots=style causes a Point graphic primitive to be placed
  76. at each control point. Default is $SplineDots.";
  77.  
  78. $SplinePoints::usage = "$SplinePoints gives the default value for 
  79. SplinePoints Option.  The initial value is 15."
  80.  
  81. $SplineDots::usage = "Default value for SplineDots Option.  The
  82. initial setting is None."
  83.     
  84. Begin["`Private`"]
  85.  
  86. Spline::cbezlen =
  87.     "You need points to generate a spline!"
  88.  
  89. Format[Spline[p_,t_,b__]] :=
  90.     SequenceForm["Spline[",p,",",t,",<>]"]
  91.  
  92. Options[Spline] := {SplinePoints -> $SplinePoints,
  93.     SplineDots-> $SplineDots}
  94.  
  95. Spline[pts_List,type_Symbol,opts:(_Rule | _RuleDelayed)...] :=
  96.     Spline[pts,type,pts,
  97.         splineinternal[pts,type],
  98.         opts]
  99.         
  100. Spline[pts_List,type_Symbol,cpts_List,
  101.                     opts:(_Rule | _RuleDelayed)...] :=
  102.     Spline[pts,type,pts,
  103.         splineinternal[pts,type],
  104.         opts]/; pts != cpts
  105.  
  106. $SplinePoints = 15;
  107.  
  108. $SplineDots = None;
  109.  
  110. (* the spline internal routines.  This is where the internal
  111.     forms for various spline types are defined. *)
  112.  
  113. splineinternal[pts_List,Cubic] :=
  114.     Module[{ln = Length[pts],mat,cpts = Transpose[pts]},
  115.         mat = multmat[ln];
  116.         Transpose[Map[splinecoord[#,mat]&,cpts]]
  117. ]
  118.  
  119. splineinternal[pts_List,CompositeBezier] :=
  120.     Module[{eqns, gpts = pts,ln = Length[pts],end},
  121.         If[ln < 3 || OddQ[ln],
  122.             Which[ln == 1, gpts = Flatten[Table[gpts,{4}]],
  123.                 ln == 2, gpts = {gpts[[1]],gpts[[1]],gpts[[2]],gpts[[2]]},
  124.                 OddQ[ln], AppendTo[gpts,Last[gpts]],
  125.                 True, Message[Spline::cbezlen];
  126.                     Return[InString[$Line]]]];
  127.         end = Take[gpts,-4];
  128.         gpts = Partition[Drop[gpts,-2],4,2];
  129.         gpts = Apply[{#1,#2,#3 - (#4 - #3),#3}&,gpts,{1}];
  130.         AppendTo[gpts,end];    
  131.         Apply[Transpose[{#1,3(#2 - #1),
  132.                 3(#3 - 2 #2 + #1),#4 - 3 #3 + 3 #2 - #1}]&,
  133.             gpts,{1}]
  134.     ]
  135.  
  136. splineinternal[pts_List,Bezier] :=
  137.     Module[{n},
  138.         Table[Binomial[Length[pts] - 1,n],
  139.             {n,0,Length[pts] - 1}]
  140.     ]
  141.  
  142. (* some functions to assist the Cubic splineinternal routine *)
  143. ShiftRight[list_] := Drop[Prepend[list,0],-1]
  144.  
  145. ShiftLeft[list_] := Drop[Append[list,0],1]
  146.  
  147. multmat[n_] := Module[{id = IdentityMatrix[n],l,r},
  148.     l = Map[ShiftLeft,id];
  149.     r = Map[ShiftRight,id];
  150.     id = l + r + 4 id;
  151.     id[[1,1]] = 2;
  152.     id[[n,n]] = 2;
  153.     id]
  154.         
  155. splinecoord[vals_,mat_] := 
  156.     Module[{lst,ln = Length[vals],d,n},
  157.         lst = Join[{3 (vals[[2]] - vals[[1]])},
  158.             Table[3 (vals[[n + 2]] - vals[[n]]),
  159.                     {n,ln - 2}],
  160.             {3 (vals[[ln]] - vals[[ln - 1]])}];
  161.         d = LinearSolve[mat,lst];
  162.         Table[{vals[[n]],d[[n]],
  163.             3(vals[[n+1]]-vals[[n]])-2 d[[n]]-d[[n+1]],
  164.             2(vals[[n]]-vals[[n+1]])+d[[n]]+d[[n+1]]},
  165.                 {n,1,ln - 1}]]
  166.  
  167. (* the splinepoints routines.  these routines covert a spline
  168.     into a list of points to actually be connected in generating
  169.     a graphic. *)
  170.  
  171. splinepoints[pts_,Cubic,internal_,res_] :=
  172.     Module[{rn,drn},
  173.         rn = Range[0,1,1/(res-1)];
  174.         drn = Map[{1,#,#^2,#^3}&,rn];
  175.         Flatten[Map[Transpose,Map[drn.#&,internal,{2}]],1]
  176.     ]
  177.  
  178. splinepoints[pts_,CompositeBezier,internal_,res_] :=
  179.     splinepoints[pts,Cubic,internal,2 res]
  180.  
  181. splinepoints[pts_,Bezier,internal_,res_] :=
  182.     Module[{rn,eq,n,deg = Length[pts] - 1},
  183.         rn = Range[0,1,1/((res - 1) * deg)];
  184.         eq = Table[#^n (1 - #)^(deg - n),{n,0,deg}];
  185.         Map[Evaluate[Plus @@ (pts internal eq)]&,rn]
  186.     ]
  187.  
  188. (* The following routines handle rendering of splines *)
  189.  
  190. splinetoline[Spline[pts_List,type_Symbol,pts_List,internal_,
  191.                 opts:(_Rule | _RuleDelayed)...]] :=
  192.     Module[{res,dots,spts},
  193.         {res,dots} = {SplinePoints,SplineDots}/.{opts}/.
  194.             Options[Spline];
  195.         spts = splinepoints[pts,type,internal,res];
  196.         If[dots === None,
  197.             Line[spts],
  198.             {Flatten[{dots,Map[Point,pts]}],Line[spts]}]
  199.     ]
  200.  
  201. splinesubsume[shape_] :=
  202.     shape/.{Spline[p_,t_,p_,c_,___,SplinePoints->r_,___] :>
  203.                 Sequence @@ splinepoints[p,t,c,r],
  204.             Spline[p_,t_,p_,c_,___] :>
  205.                 Sequence @@ splinepoints[p,t,c,SplinePoints/.
  206.                                 Options[Spline]]}
  207.  
  208. Unprotect[Display];
  209.  
  210. Display[f_,gr_?(!FreeQ[#,Spline[___]]&),opts___] :=
  211.     (Display[f,gr/.{p:(Polygon[{___,_Spline,___}] | 
  212.                             Line[{___,_Spline,___}]) :>
  213.                     splinesubsume[p],
  214.                 v:Spline[___]:>splinetoline[v]},
  215.             opts];
  216.             gr)
  217.  
  218. Protect[Display];
  219.  
  220. End[]
  221.  
  222. EndPackage[]
  223.  
  224.