Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/graph-util/spline.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/graph-util/spline.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* spline.sml
2 :     *
3 :     * COPYRIGHT (c) 1991 by AT&T Bell Laboratories See COPYRIGHT file for details.
4 :     *)
5 :    
6 :     structure Spline : SPLINE =
7 :     struct
8 :    
9 :     structure G = Geometry
10 :     open G
11 :    
12 :     fun round x = if x > 0.0 then floor (x+0.5) else ~1*floor(~x+0.5)
13 :    
14 :     fun addSeg ([], x0,y0,x1,y1) =
15 :     [PT{x = round x0, y = round y0}, PT{x = round x1, y = round y1}]
16 :     | addSeg (l, x0, y0, _,_) = (PT{x = round x0, y = round y0})::l
17 :    
18 :     (* isFlat:
19 :     * Returns true if the polygon determined by the four points
20 :     * is flat enough. Flatness is measured by the maximum distance
21 :     * of (x1,y1) and (x2,y2) from the line determined by (x0,y0)
22 :     * and (x3,y3). In addition, check that p1, p2 are close to the
23 :     * line segment. To do this, make sure they are roughly within
24 :     * the circle with center (p0+p3)/2 and radius = |p3-p0|/2+flatness
25 :     *)
26 :     fun isFlat {x0, y0, x1, y1, x2, y2, x3, y3} = let
27 :     fun sqr x = x * x
28 :     val dx = x3 - x0 and dy = y3 - y0
29 :     val midx = 0.5*dx and midy = 0.5*dy and dist2 = sqr dy + sqr dx
30 :     val flatness2 = sqr 1.0 * dist2 and halfd2 = 0.25*dist2
31 :     fun inFlatRange (x,y) = sqr(dy * x - dx * y) <= flatness2
32 :     andalso let val d = sqr(x-midx) + sqr(y-midy)
33 :     in d<=halfd2 orelse sqr(d-halfd2)<=flatness2 end
34 :     in
35 :     inFlatRange (x1-x0, y1-y0) andalso inFlatRange (x2-x0, y2-y0)
36 :     end
37 :    
38 :     (* bezier:
39 :     * Recursively compute a Bezier cubic section. If the points
40 :     * determine a polygon flat enough to be represented as a line
41 :     * segment, the segment is added to the list. Otherwise, the
42 :     * the curve is bisected and each part is recursively computed,
43 :     * with the lists concatenated.
44 :     *
45 :     * From "The Beta2-split: A special case of the Beta-spline Curve and
46 :     * Surface Representation." B. A. Barsky and A. D. DeRose. IEEE, 1985,
47 :     * as adapted by Crispin Goswell for xps.
48 :     *)
49 :     fun bezier (arg as {x0,y0,x1,y1,x2,y2,x3,y3}, l) = if (isFlat arg)
50 :     then addSeg(l, x0, y0, x3, y3)
51 :     else let
52 :     val mid_x = (x0 + x3) / 8.0 + 3.0 * (x1 + x2) / 8.0
53 :     val mid_y = (y0 + y3) / 8.0 + 3.0 * (y1 + y2) / 8.0
54 :     val l' = bezier ({
55 :     x0 = mid_x, y0 = mid_y,
56 :     x1 = (x1+x3) / 4.0 + x2 / 2.0, y1 = (y1+y3) / 4.0 + y2 / 2.0,
57 :     x2 = (x2+x3) / 2.0, y2 = (y2+y3) / 2.0,
58 :     x3 = x3, y3 = y3
59 :     }, l)
60 :     in
61 :     bezier ({
62 :     x0 = x0, y0 = y0,
63 :     x1 = (x0+x1) / 2.0, y1 = (y0+y1) / 2.0,
64 :     x2 = (x0+x2) / 4.0 + x1 / 2.0, y2 = (y0+y2) / 4.0 + y1 / 2.0,
65 :     x3 = mid_x, y3 = mid_y
66 :     }, l')
67 :     end
68 :    
69 :     (* curve:
70 :     * Given four points [p0,p1,p2,p3], return a list of points corresponding to
71 :     * to a Bezier cubic section, starting at p0, ending at p3, with p1, p2 as
72 :     * control points.
73 :     *
74 :     *)
75 :     fun curve (PT{x=x0,y=y0}, PT{x=x1,y=y1}, PT{x=x2,y=y2}, PT{x=x3,y=y3}) =
76 :     bezier ({
77 :     x0 = real x0, y0 = real y0,
78 :     x1 = real x1, y1 = real y1,
79 :     x2 = real x2, y2 = real y2,
80 :     x3 = real x3, y3 = real y3
81 :     }, [])
82 :    
83 :     (* doSpline:
84 :     * Given four points (p0,p1,p2,p3), return a list of points corresponding to
85 :     * to the B-spline curve section, accumulating the results on the argument list.
86 :     * We compute the curve by determining the corresponding Bezier control points,
87 :     * and then use the Bezier routines above.
88 :     *
89 :     *)
90 :     fun doSpline (PT{x=x0,y=y0}, PT{x=x1,y=y1}, PT{x=x2,y=y2}, PT{x=x3,y=y3}, l) = let
91 :     val x0 = real x0 and y0 = real y0
92 :     val x1 = real x1 and y1 = real y1
93 :     val x2 = real x2 and y2 = real y2
94 :     val x3 = real x3 and y3 = real y3
95 :     in
96 :     bezier ({
97 :     x0 = (x0 + 4.0*x1 + x2)/6.0, y0 = (y0+ 4.0*y1 + y2)/6.0,
98 :     x1 = (2.0*x1 + x2)/3.0, y1 = (2.0*y1 + y2)/3.0,
99 :     x2 = (x1 + 2.0*x2)/3.0, y2 = (y1 + 2.0*y2)/3.0,
100 :     x3 = (x1 + 4.0*x2 + x3)/6.0, y3 = (y1 + 4.0*y2 + y3)/6.0
101 :     }, l)
102 :     end
103 :    
104 :     (* loopSpline:
105 :     * Given a list of spline control points, generate the corresponding
106 :     * spline. Since we accumulate on the head of the list, we assume
107 :     * the calling function has reversed the list of control points.
108 :     * The loop continues as long as there are 4 control points left.
109 :     *)
110 :     fun loopSpline (p3, p2, p1, p0::tl, l) =
111 :     loopSpline (p2, p1, p0, tl, doSpline(p0, p1, p2, p3, l))
112 :     | loopSpline (_, _, _, [], l) = l
113 :    
114 :     (* simpleBSpline:
115 :     * Compute a simple B-spline with the given control points.
116 :     *)
117 :     fun simpleBSpline arg = (case (rev arg)
118 :     of (p3::p2::p1::tl) => loopSpline (p3,p2,p1,tl,[])
119 :     | _ => arg
120 :     (* end case *))
121 :    
122 :     (* bSpline:
123 :     * Compute a B-spline using the given control points.
124 :     * In addition, we constrain the resultant spline to connect the
125 :     * first and last points by adding copies of these points.
126 :     *)
127 :     fun bSpline (arg as (p0::_::_::_)) = let
128 :     val (pn::tl) = rev (p0::p0::arg)
129 :     in
130 :     loopSpline (pn, pn, pn, tl, [])
131 :     end
132 :     | bSpline l = l
133 :    
134 :     (* closedBSpline:
135 :     * Compute a closed B-spline. This is done by repeating the first
136 :     * three points at the end of the list.
137 :     * Note that the first and last points of the result are the same.
138 :     *)
139 :     fun closedBSpline (arg as (p0::p1::p2::_)) = loopSpline(p2,p1,p0,rev arg,[])
140 :     | closedBSpline l = l
141 :    
142 :     end (* Spline *)
143 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0