add Galois' Ray Tracer
[nofib.git] / parallel / gray / Construct.hs
1 -- Copyright (c) 2000 Galois Connections, Inc.
2 -- All rights reserved. This software is distributed as
3 -- free software under the license in the file "LICENSE",
4 -- which is included in the distribution.
5
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
21
22 import Geometry
23
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.
29
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
36
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
52
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)
65
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)
71
72 union, intersect, difference :: CSG a -> CSG a -> CSG a
73
74 union p@(Box b1 _) q@(Box b2 _) = Box (mergeBox b1 b2) (Union p q)
75 union p q = Union p q
76
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
80
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
85
86 mkBox b p = Box b p
87
88 plane, sphere, cube, cylinder, cone :: a -> CSG a
89
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)
107
108 ----------------------------
109 -- Object transformations
110 ----------------------------
111
112 type Transform = (Matrix, Matrix)
113
114 transform :: Transform -> CSG a -> CSG a
115
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
122
123 translate :: Coords -> CSG a -> CSG a
124 translateX, translateY, translateZ :: Double -> CSG a -> CSG a
125
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)
130
131 scale :: Coords -> CSG a -> CSG a
132 scaleX, scaleY, scaleZ, uscale :: Double -> CSG a -> CSG a
133
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)
139
140 rotateX, rotateY, rotateZ :: Radian -> CSG a -> CSG a
141
142 rotateX a = transform $ rotxM a
143 rotateY a = transform $ rotyM a
144 rotateZ a = transform $ rotzM a
145
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 ) )
151
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 ) ) )
163
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
178
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 ) ) )
190
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 ) ) )
202
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 ) ) )
214
215 -------------------
216 -- Eye transformations
217
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 -------------------
222
223 eye :: Transform
224 translateEye :: Coords -> Transform -> Transform
225 rotateEyeX, rotateEyeY, rotateEyeZ :: Radian -> Transform -> Transform
226
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
240
241 -------------------
242 -- Bounding boxes
243 -------------------
244
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)
249
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]