1 -- Copyright (c) 2000 Galois Connections, Inc.
4 -- which is included in the distribution.
6 module Construct
7 ( Surface (..)
8 , Face (..)
9 , CSG (..)
10 , Texture
11 , Transform
12 , union, intersect, difference
13 , plane, sphere, cube, cylinder, cone
14 , transform
15 , translate, translateX, translateY, translateZ
16 , scale, scaleX, scaleY, scaleZ, uscale
17 , rotateX, rotateY, rotateZ
18 , eye, translateEye
19 , rotateEyeX, rotateEyeY, rotateEyeZ
20 ) where
22 import Geometry
24 -- In each case, we model the surface by a point and a pair of tangent vectors.
25 -- This gives us enough information to determine the surface
26 -- normal at that point, which is all that is required by the current
27 -- illumination model. We can't just save the surface normal because
28 -- that isn't preserved by transformations.
30 data Surface
31 = Planar Point Vector Vector
32 | Spherical Point Vector Vector
33 | Cylindrical Point Vector Vector
34 | Conic Point Vector Vector
35 deriving Show
37 data Face
38 = PlaneFace
39 | SphereFace
40 | CubeFront
41 | CubeBack
42 | CubeLeft
43 | CubeRight
44 | CubeTop
45 | CubeBottom
46 | CylinderSide
47 | CylinderTop
48 | CylinderBottom
49 | ConeSide
50 | ConeBase
51 deriving Show
53 data CSG a
54 = Plane a
55 | Sphere a
56 | Cylinder a
57 | Cube a
58 | Cone a
59 | Transform Matrix Matrix (CSG a)
60 | Union (CSG a) (CSG a)
61 | Intersect (CSG a) (CSG a)
62 | Difference (CSG a) (CSG a)
63 | Box Box (CSG a)
64 deriving (Show)
66 -- the data returned for determining surface texture
67 -- the Face tells which face of a primitive this is
68 -- the Point is the point of intersection in object coordinates
69 -- the a is application-specific texture information
70 type Texture a = (Face, Point, a)
72 union, intersect, difference :: CSG a -> CSG a -> CSG a
74 union p@(Box b1 _) q@(Box b2 _) = Box (mergeBox b1 b2) (Union p q)
75 union p q = Union p q
77 -- rather pessimistic
78 intersect p@(Box b1 _) q@(Box b2 _) = Box (mergeBox b1 b2) (Intersect p q)
79 intersect p q = Intersect p q
81 difference (Box b1 p) q = Box b1 (Difference p q)
82 -- no need to box again inside
83 -- difference p@(Box b1 _) q = Box b1 (Difference p q)
84 difference p q = Difference p q
86 mkBox b p = Box b p
88 plane, sphere, cube, cylinder, cone :: a -> CSG a
90 plane = Plane
91 sphere s =
92 mkBox (B (-1 - epsilon) (1 + epsilon)
93 (-1 - epsilon) (1 + epsilon)
94 (-1 - epsilon) (1 + epsilon)) (Sphere s)
95 cone s =
96 mkBox (B (-1 - epsilon) (1 + epsilon)
97 ( - epsilon) (1 + epsilon)
98 (-1 - epsilon) (1 + epsilon)) (Cone s)
99 cube s =
100 mkBox (B (- epsilon) (1 + epsilon)
101 (- epsilon) (1 + epsilon)
102 (- epsilon) (1 + epsilon)) (Cube s)
103 cylinder s =
104 mkBox (B (-1 - epsilon) (1 + epsilon)
105 ( - epsilon) (1 + epsilon)
106 (-1 - epsilon) (1 + epsilon)) (Cylinder s)
108 ----------------------------
109 -- Object transformations
110 ----------------------------
112 type Transform = (Matrix, Matrix)
114 transform :: Transform -> CSG a -> CSG a
116 transform (m, m') (Transform mp mp' p) = Transform (multMM m mp) (multMM mp' m') p
117 transform mm' (Union p q) = Union (transform mm' p) (transform mm' q)
118 transform mm' (Intersect p q) = Intersect (transform mm' p) (transform mm' q)
119 transform mm' (Difference p q) = Difference (transform mm' p) (transform mm' q)
120 transform mm'@(m,_) (Box box p) = Box (transformBox m box) (transform mm' p)
121 transform (m, m') prim = Transform m m' prim
123 translate :: Coords -> CSG a -> CSG a
124 translateX, translateY, translateZ :: Double -> CSG a -> CSG a
126 translate xyz = transform \$ transM xyz
127 translateX x = translate (x, 0, 0)
128 translateY y = translate (0, y, 0)
129 translateZ z = translate (0, 0, z)
131 scale :: Coords -> CSG a -> CSG a
132 scaleX, scaleY, scaleZ, uscale :: Double -> CSG a -> CSG a
134 scale xyz = transform \$ scaleM xyz
135 scaleX x = scale (x, 1, 1)
136 scaleY y = scale (1, y, 1)
137 scaleZ z = scale (1, 1, z)
138 uscale u = scale (u,u,u)
140 rotateX, rotateY, rotateZ :: Radian -> CSG a -> CSG a
142 rotateX a = transform \$ rotxM a
143 rotateY a = transform \$ rotyM a
144 rotateZ a = transform \$ rotzM a
146 unit = matrix
147 ( ( 1.0, 0.0, 0.0, 0.0 ),
148 ( 0.0, 1.0, 0.0, 0.0 ),
149 ( 0.0, 0.0, 1.0, 0.0 ),
150 ( 0.0, 0.0, 0.0, 1.0 ) )
152 transM (x, y, z)
153 = ( matrix
154 ( ( 1, 0, 0, x ),
155 ( 0, 1, 0, y ),
156 ( 0, 0, 1, z ),
157 ( 0, 0, 0, 1 ) ),
158 matrix
159 ( ( 1, 0, 0, -x ),
160 ( 0, 1, 0, -y ),
161 ( 0, 0, 1, -z ),
162 ( 0, 0, 0, 1 ) ) )
164 scaleM (x, y, z)
165 = ( matrix
166 ( ( x', 0, 0, 0 ),
167 ( 0, y', 0, 0 ),
168 ( 0, 0, z', 0 ),
169 ( 0, 0, 0, 1 ) ),
170 matrix
171 ( ( 1/x', 0, 0, 0 ),
172 ( 0, 1/y', 0, 0 ),
173 ( 0, 0, 1/z', 0 ),
174 ( 0, 0, 0, 1 ) ) )
175 where x' = nonZero x
176 y' = nonZero y
177 z' = nonZero z
179 rotxM t
180 = ( matrix
181 ( ( 1, 0, 0, 0 ),
182 ( 0, cos t, -sin t, 0 ),
183 ( 0, sin t, cos t, 0 ),
184 ( 0, 0, 0, 1 ) ),
185 matrix
186 ( ( 1, 0, 0, 0 ),
187 ( 0, cos t, sin t, 0 ),
188 ( 0, -sin t, cos t, 0 ),
189 ( 0, 0, 0, 1 ) ) )
191 rotyM t
192 = ( matrix
193 ( ( cos t, 0, sin t, 0 ),
194 ( 0, 1, 0, 0 ),
195 ( -sin t, 0, cos t, 0 ),
196 ( 0, 0, 0, 1 ) ),
197 matrix
198 ( ( cos t, 0, -sin t, 0 ),
199 ( 0, 1, 0, 0 ),
200 ( sin t, 0, cos t, 0 ),
201 ( 0, 0, 0, 1 ) ) )
203 rotzM t
204 = ( matrix
205 ( ( cos t, -sin t, 0, 0 ),
206 ( sin t, cos t, 0, 0 ),
207 ( 0, 0, 1, 0 ),
208 ( 0, 0, 0, 1 ) ),
209 matrix
210 ( ( cos t, sin t, 0, 0 ),
211 ( -sin t, cos t, 0, 0 ),
212 ( 0, 0, 1, 0 ),
213 ( 0, 0, 0, 1 ) ) )
215 -------------------
216 -- Eye transformations
218 -- These are used to specify placement of the eye.
219 -- `eye' starts out at (0, 0, -1).
220 -- These are implemented as inverse transforms of the model.
221 -------------------
223 eye :: Transform
224 translateEye :: Coords -> Transform -> Transform
225 rotateEyeX, rotateEyeY, rotateEyeZ :: Radian -> Transform -> Transform
227 eye = (unit, unit)
228 translateEye xyz (eye1, eye2)
229 = (multMM m1 eye1, multMM eye2 m2)
230 where (m1, m2) = transM xyz
231 rotateEyeX t (eye1, eye2)
232 = (multMM m1 eye1, multMM eye2 m2)
233 where (m1, m2) = rotxM t
234 rotateEyeY t (eye1, eye2)
235 = (multMM m1 eye1, multMM eye2 m2)
236 where (m1, m2) = rotyM t
237 rotateEyeZ t (eye1, eye2)
238 = (multMM m1 eye1, multMM eye2 m2)
239 where (m1, m2) = rotzM t
241 -------------------
242 -- Bounding boxes
243 -------------------
245 mergeBox (B x11 x12 y11 y12 z11 z12) (B x21 x22 y21 y22 z21 z22) =
246 B (x11 `min` x21) (x12 `max` x22)
247 (y11 `min` y21) (y12 `max` y22)
248 (z11 `min` z21) (z12 `max` z22)
250 transformBox t (B x1 x2 y1 y2 z1 z2)
251 = (B (foldr1 min (map xCoord pts'))
252 (foldr1 max (map xCoord pts'))
253 (foldr1 min (map yCoord pts'))
254 (foldr1 max (map yCoord pts'))
255 (foldr1 min (map zCoord pts'))
256 (foldr1 max (map zCoord pts')))
257 where pts' = map (multMP t) pts
258 pts = [point x1 y1 z1,
259 point x1 y1 z2,
260 point x1 y2 z1,
261 point x1 y2 z2,
262 point x2 y1 z1,
263 point x2 y1 z2,
264 point x2 y2 z1,
265 point x2 y2 z2]