Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] Annotation of /trunk/sml3d/src/particles/compiler/translate.sml
ViewVC logotype

Annotation of /trunk/sml3d/src/particles/compiler/translate.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1130 - (view) (download)

1 : pavelk 746 (* translate.sml
2 : pavelk 1108
3 : pavelk 746 * COPYRIGHT (c) 2009 John Reppy (http://cs.uchicago.edu/~jhr)
4 :     * All rights reserved.
5 :     *
6 :     * Translate a particle system to the IR.
7 :     *)
8 :    
9 :     structure Translate : sig
10 :    
11 : jhr 1050 val compile : Particles.program -> PSysIR.program
12 : pavelk 746
13 :     end = struct
14 :    
15 :     open SML3dTypeUtil
16 :    
17 :     structure P = ParticlesImp
18 :     structure PSV = P.PSV
19 :     structure IR = PSysIR
20 : pavelk 770
21 :     fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")
22 : pavelk 746
23 : pavelk 1107 (*
24 : pavelk 746 datatype particle_state = PS of {
25 : pavelk 1091 pos : IR.var, (* vec3 *)
26 :     vel : IR.var, (* vec3 *)
27 :     size : IR.var, (* float *)
28 :     ttl : IR.var, (* float *)
29 :     color : IR.var, (* vec3 (NOTE: should be vector4) *)
30 :     user : IR.var list
31 :     }
32 : pavelk 1107 *)
33 :     type particle_state = IR.var list
34 : pavelk 746
35 :     (* special PSV global variables *)
36 :     val epsilon = PSV.constf(0.00001)
37 :    
38 :     (* constants *)
39 :     val pi = 3.14159265358979
40 : pavelk 870
41 : pavelk 1109 fun retState s = IR.mkRETURN s
42 : pavelk 870
43 : pavelk 746 (* translation environment *)
44 : pavelk 1109 datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)
45 :     fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))
46 : pavelk 746
47 : pavelk 1109 (* Interaction with environment and state variables *)
48 :     fun psvToIRVar (TE(_, env), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)
49 : pavelk 746 of SOME x' => x'
50 : pavelk 770 | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
51 : pavelk 1108 (* end case *))
52 :    
53 : pavelk 1109 fun findIRVarByName (state, name) = let
54 :     fun eq (var as IR.V{name=st_name, ...}) = st_name = ("ps_" ^ name)
55 :     in
56 :     (case (List.find eq state)
57 :     of SOME sv => sv
58 :     | NONE => raise Fail ("Could not find var mapping.")
59 :     (* end case *))
60 :     end
61 :    
62 :     fun getIRVarForSV (v as PSV.SV{name, ...}, state) = findIRVarByName(state, name)
63 : pavelk 746
64 : pavelk 1109 (* create a block that implements the given continuation *)
65 :     fun newBlockWithArgs (TE(blks, _), state , args, k : particle_state -> IR.stmt) = let
66 :     fun copyVar(v as IR.V{name, varType, ...}) = IR.newParam(name, varType)
67 :     val newState = List.map copyVar state
68 :     val blk = IR.newBlock (newState @ args, k newState)
69 : pavelk 746 in
70 : pavelk 1107 blks := blk :: !blks;
71 :     blk
72 : pavelk 746 end
73 :    
74 : pavelk 1107 fun newBlock (env, state, k) = newBlockWithArgs(env, state, [], k)
75 : pavelk 746
76 : pavelk 1107 fun gotoWithArgs(state, args, blk) = IR.mkGOTO(blk, state @ args)
77 :     fun goto (state, blk) = gotoWithArgs(state, [], blk)
78 : pavelk 746
79 :     fun letPRIM (x, ty, p, args, body) = let
80 :     val x' = IR.newLocal(x, ty, (p, args))
81 :     in
82 :     IR.mkPRIM(x', p, args, body x')
83 :     end
84 :    
85 :     (* Not sure if this should be made into a primitive or not, but
86 :     * basically this creates the XOR'd value of var1 and var2 and
87 :     * stores it in result.
88 :     *)
89 :     fun mkXOR (result, var1, var2, stmt : IR.var -> IR.stmt) =
90 :     letPRIM("testOR", IR.T_BOOL, IR.OR, [var1, var2], fn testOR =>
91 :     letPRIM("testAND", IR.T_BOOL, IR.AND, [var1, var2], fn testAND =>
92 :     letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>
93 :     letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))
94 :    
95 : pavelk 1017 fun genFloatVar (fltVar, env, domain : Float.float P.domain, dist, stmt : IR.var -> IR.stmt) = let
96 :     fun genRandVal(var, stmt : IR.var -> IR.stmt) = (case dist
97 :     of P.DIST_UNIFORM =>
98 :     letPRIM(var, IR.T_FLOAT, IR.RAND, [], stmt)
99 :    
100 :     (* The PDF here is f(x) = 2x when 0 < x <= 1, so the CDF is going
101 :     * to be the integral of f from 0 -> y => y^2. Hence, whenever we
102 :     * generate a random number, in order to get the random value according
103 :     * to this probability distribution, we just square it.
104 :     *)
105 :     | P.DIST_INC_LIN =>
106 :     letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
107 :     letPRIM(var, IR.T_FLOAT, IR.MULT, [randVal, randVal], stmt))
108 :    
109 :     (* The PDF here is f(x) = -2x + 2 when 0 <= x < 1, so the CDF is going
110 :     * to be the integral of f from 0 -> y => -(y^2) + 2y. Hence, whenever we
111 :     * generate a random number, in order to get the random value according
112 :     * to this probability distribution, we just square it.
113 :     *)
114 :     | P.DIST_DEC_LIN =>
115 :     letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
116 :     letPRIM("randSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randSq =>
117 :     letPRIM("termOne", IR.T_FLOAT, IR.MULT, [randSq, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn termOne =>
118 :     letPRIM("termTwo", IR.T_FLOAT, IR.MULT, [randVal, IR.newConst("negOne", IR.C_FLOAT 2.0)], fn termTwo =>
119 :     letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)
120 :     ))))
121 :    
122 :     | _ => raise Fail "Unable to create random float for specified distribution."
123 :     (* end case *))
124 :     in
125 :     (case domain
126 :     of P.D_POINT(pt) =>
127 :     (* Our options here are pretty limited... *)
128 :     letPRIM (fltVar, IR.T_FLOAT, IR.COPY, [psvToIRVar(env, pt)], stmt)
129 :    
130 :     | P.D_BOX{max, min} =>
131 :     genRandVal("randf", fn rand =>
132 :     letPRIM("boxDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, max), psvToIRVar(env, max)], fn diff =>
133 :     letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>
134 :     letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )
135 :     )))
136 :     | _ => raise Fail "Cannot generate float in specified domain."
137 :     (* end case *))
138 :     end
139 :    
140 : pavelk 746 (* Generates a random vector within the given domain and puts it in vecVar *)
141 : pavelk 1108 fun genVecVar (
142 :     vecVar,
143 :     env,
144 :     domain : Vec3f.vec3 P.domain,
145 :     dist : Vec3f.vec3 P.distribution,
146 :     stmt : IR.var -> IR.stmt
147 :     ) = (case domain
148 : pavelk 746 of P.D_POINT(pt) =>
149 :     (* Our options here are pretty limited... *)
150 :     letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
151 :    
152 :     | P.D_LINE({pt1, pt2}) =>
153 :     (* Lerp between the points. *)
154 :     letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
155 :     letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
156 :     letPRIM ("pt1s", IR.T_VEC, IR.SCALE, [randVal, psvToIRVar(env, pt1)], fn pt1ScaleVec =>
157 :     letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>
158 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
159 :    
160 : pavelk 873 | P.D_BOX{max, min} =>
161 :     (* Extract the componentwise vector variables *)
162 :     letPRIM("minX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, min)], fn minX =>
163 :     letPRIM("maxX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, max)], fn maxX =>
164 :     letPRIM("minY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, min)], fn minY =>
165 :     letPRIM("maxY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, max)], fn maxY =>
166 :     letPRIM("minZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, min)], fn minZ =>
167 :     letPRIM("maxZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, max)], fn maxZ =>
168 :    
169 :     (* Find the distance in each component *)
170 :     letPRIM("distX", IR.T_FLOAT, IR.SUB, [maxX, minX], fn distX =>
171 :     letPRIM("distY", IR.T_FLOAT, IR.SUB, [maxY, minY], fn distY =>
172 :     letPRIM("distZ", IR.T_FLOAT, IR.SUB, [maxZ, minZ], fn distZ =>
173 :    
174 :     (* Get three random numbers for each of the components *)
175 :     letPRIM("randX", IR.T_FLOAT, IR.RAND, [], fn randX =>
176 :     letPRIM("randY", IR.T_FLOAT, IR.RAND, [], fn randY =>
177 :     letPRIM("randZ", IR.T_FLOAT, IR.RAND, [], fn randZ =>
178 :    
179 :     (* Scale the distances by these random numbers *)
180 :     letPRIM("scaledX", IR.T_FLOAT, IR.MULT, [randX, distX], fn scaledX =>
181 :     letPRIM("scaledY", IR.T_FLOAT, IR.MULT, [randY, distY], fn scaledY =>
182 :     letPRIM("scaledZ", IR.T_FLOAT, IR.MULT, [randZ, distZ], fn scaledZ =>
183 :    
184 :     (* Add them to the minimum vec in order to create a new vec inside
185 :     * of the box.
186 :     *)
187 :     letPRIM("newX", IR.T_FLOAT, IR.ADD, [minX, scaledX], fn newX =>
188 :     letPRIM("newY", IR.T_FLOAT, IR.ADD, [minY, scaledY], fn newY =>
189 :     letPRIM("newZ", IR.T_FLOAT, IR.ADD, [minZ, scaledZ], fn newZ =>
190 :    
191 :     (* Gen the vector *)
192 :     letPRIM(vecVar, IR.T_VEC, IR.GEN_VEC, [newX, newY, newZ], stmt
193 :    
194 :     )))))))))))))))))))
195 :    
196 : pavelk 746
197 :     | P.D_TRIANGLE{pt1, pt2, pt3} =>
198 :     letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>
199 :     letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>
200 :     letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
201 :     letPRIM ("randTwo", IR.T_FLOAT, IR.RAND, [], fn rand2 =>
202 :     letPRIM ("randTwoInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), rand2], fn rand2Inv =>
203 :     letPRIM ("scaleOne", IR.T_VEC, IR.SCALE, [rand1, pt1ToPt2], fn scale1 =>
204 :     letPRIM ("nextScale1", IR.T_VEC, IR.SCALE, [rand2Inv, scale1], fn nextScale1 =>
205 :     letPRIM ("scaleTwo", IR.T_VEC, IR.SCALE, [rand2, pt1ToPt3], fn scale2 =>
206 :     letPRIM ("tempAdd", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, pt1), nextScale1], fn tempAdd =>
207 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [tempAdd, scale2], stmt))))))))))
208 :    
209 :     | P.D_CYLINDER {pt1, pt2, irad, orad} => let
210 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
211 :     in
212 :     letPRIM("rand", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
213 :     letPRIM("n", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
214 :     letPRIM("ht", IR.T_FLOAT, IR.LEN, [normVec], fn height =>
215 :     letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>
216 :     letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
217 :     (* Generate a point in the lower disc. *)
218 : pavelk 1109 genVecVar("ptInDisc",
219 :     insert(env, normVar, norm),
220 :     P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
221 :     dist,
222 :     fn ptInDisc =>
223 : pavelk 746 (* Now add this point to a random scaling of the normVec. *)
224 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
225 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
226 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
227 :     end
228 :    
229 :     | P.D_DISC {pt, normal, irad, orad} =>
230 :     (* Get a random angle... *)
231 :     letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
232 :     letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>
233 :     (* Get a random radius *)
234 :     letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
235 :     letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>
236 :     letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
237 :     letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
238 :     letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>
239 :     (* Find a vector in the plane of the disc, and then
240 :     * translate it to the center.
241 :     *)
242 :     letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>
243 :     letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>
244 :     letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>
245 :     letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>
246 :     letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>
247 :     (* Figure out x and y values for our new radius and angle *)
248 :     letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>
249 :     letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>
250 :     letPRIM ("rv1", IR.T_VEC, IR.SCALE, [amtVecOne, vecInDiscNorm], fn resVecOne =>
251 :     letPRIM ("ry", IR.T_FLOAT, IR.SIN, [randAng], fn radY =>
252 :     letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>
253 :     letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>
254 :     letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>
255 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt))))))))))))))))))))
256 :    
257 :     | P.D_CONE{pt1, pt2, irad, orad} => let
258 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
259 :     in
260 :     letPRIM("eh", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
261 :     letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
262 :     letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
263 : pavelk 1109 genVecVar("ptInDisc",
264 :     insert(env, normVar, norm),
265 :     P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
266 :     dist,
267 :     fn ptInDisc =>
268 : pavelk 746 letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>
269 :     letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
270 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
271 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>
272 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
273 :     end
274 : pavelk 1074
275 :     | P.D_SPHERE{center, irad, orad} =>
276 :    
277 :     (* generate two random angles... *)
278 :     letPRIM("r1", IR.T_FLOAT, IR.RAND, [], fn randForAngOne =>
279 :     letPRIM("t1", IR.T_FLOAT, IR.MULT, [randForAngOne, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngOne =>
280 :     letPRIM("r2", IR.T_FLOAT, IR.RAND, [], fn randForAngTwo =>
281 :     letPRIM("t2", IR.T_FLOAT, IR.MULT, [randForAngTwo, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngTwo =>
282 :    
283 :     (* Generate vector in the sphere ... *)
284 :     (* If my math is correct this should be
285 :     * <(cos t1)(cos t2), (sin t1)(cos t2), sin t2>
286 :     * This is different from wikipedia's article on spherical coordinates
287 :     * because of a phase shift, but for the generation of random numbers,
288 :     * it's irrelevant.
289 :     *)
290 :     letPRIM("cost1", IR.T_FLOAT, IR.COS, [randAngOne], fn cost1 =>
291 :     letPRIM("cost2", IR.T_FLOAT, IR.COS, [randAngTwo], fn cost2 =>
292 :     letPRIM("sint1", IR.T_FLOAT, IR.SIN, [randAngOne], fn sint1 =>
293 :     letPRIM("sint2", IR.T_FLOAT, IR.SIN, [randAngTwo], fn sint2 =>
294 :    
295 :     letPRIM("xVal", IR.T_FLOAT, IR.MULT, [cost1, cost2], fn xVal =>
296 :     letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sint1, cost2], fn yVal =>
297 :     (* zval is just sint2 *)
298 :    
299 :     letPRIM("xVec", IR.T_VEC, IR.SCALE, [xVal, IR.newConst("xDir", IR.C_VEC {x=1.0, y=0.0, z=0.0})], fn xVec =>
300 :     letPRIM("yVec", IR.T_VEC, IR.SCALE, [yVal, IR.newConst("yDir", IR.C_VEC {x=0.0, y=1.0, z=0.0})], fn yVec =>
301 :     letPRIM("zVec", IR.T_VEC, IR.SCALE, [sint2, IR.newConst("zDir", IR.C_VEC {x=0.0, y=0.0, z=1.0})], fn zVec =>
302 :    
303 :     letPRIM("addedVecs", IR.T_VEC, IR.ADD_VEC, [xVec, yVec], fn addedVecs =>
304 :     letPRIM("notNormVec", IR.T_VEC, IR.ADD_VEC, [addedVecs, zVec], fn nnVec =>
305 :     letPRIM("vec", IR.T_VEC, IR.NORM, [nnVec], fn vec =>
306 :    
307 :     (* Generate a random radius... *)
308 :     letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>
309 :     letPRIM("invRatio", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), ratio], fn invRatio =>
310 :     letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>
311 :     letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>
312 :     letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>
313 :     letPRIM("randValSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randValSq =>
314 :     letPRIM("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
315 :     letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>
316 :     letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>
317 :    
318 :     (* Normalize the vector and scale it by the radius. *)
319 :     letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>
320 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)
321 :     ))))))))))
322 :     ))))))))))))
323 :     ))))
324 : pavelk 746
325 :     | _ => raise Fail "Cannot generate point in specified domain."
326 :     (* end case *))
327 :     (*
328 :     | generate (Dplane{pt, n}) = Vec3f.unpack pt
329 :     | generate (Drectangle{pt, u, v}) = Vec3f.unpack pt
330 :     | generate (Dsphere{c, orad, irad}) = Vec3f.unpack c
331 :     | generate (Dblob{c, stddev}) = Vec3f.unpack c
332 :     *)
333 :    
334 :     (* This function takes an IR boolean, its environment, a particle state, domain,
335 :     * and continuation.
336 :     *
337 :     * We set the boolean to whether or not the current particle given by the particle
338 :     * state is within the domain, and then pass the continuation on.
339 :     *)
340 : pavelk 1120 fun mkVecWithinVar (boolVar, env, var, d : Vec3f.vec3 P.domain, stmt : IR.var -> IR.stmt) = let
341 : pavelk 770 val pos = var
342 : pavelk 746 in
343 :     case d
344 :     of P.D_POINT(pt) =>
345 :     letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn subVec =>
346 :     letPRIM("vecLen", IR.T_FLOAT, IR.LEN, [subVec], fn vecLen =>
347 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), vecLen], stmt)))
348 :    
349 :     (* Take the vectors going from our position to pt1, and pt2. Then
350 :     * after we normalize them, if their dot product is equal to -1, then
351 :     * they are pointing in opposite directions meaning that the position
352 :     * is inbetween pt1 and pt2 as desired.
353 :     *)
354 :     | P.D_LINE{pt1, pt2} =>
355 :     letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn posToPt1 =>
356 :     letPRIM("posToPt1Norm", IR.T_VEC, IR.NORM, [posToPt1], fn posToPt1Norm =>
357 :     letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), pos], fn posToPt2 =>
358 :     letPRIM("posToPt2Norm", IR.T_VEC, IR.NORM, [posToPt2], fn posToPt2Norm =>
359 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt2, posToPt1], fn dotProd =>
360 :     letPRIM("testMe", IR.T_FLOAT, IR.SUB, [dotProd, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn testVal =>
361 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), testVal], stmt)))))))
362 :    
363 :     (* Just see whether or not the dot product between the normal
364 :     * and the vector from a point on the plane to our position is
365 :     * greater than zero. Essentially, we're "within" a plane if we're
366 :     * behind it (with respect to the normal)
367 :     *)
368 :     | P.D_PLANE{pt, normal} =>
369 : pavelk 905 letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
370 : pavelk 746 letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
371 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))
372 :    
373 :     (* Similar to checking to see whether or not we're within a plane,
374 :     * here all we have to do is see how far we are from the center
375 :     * of the disc (pt), and then see whther or not we're perpendicular to
376 :     * the normal, and that our distance is greater than irad but less than
377 :     * orad.
378 :     *)
379 :     | P.D_DISC{pt, normal, orad, irad} =>
380 : pavelk 907 letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
381 : pavelk 746 letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
382 :     letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>
383 : pavelk 987
384 :     letPRIM("parPosToP", IR.T_VEC, IR.SCALE, [dotProd, psvToIRVar(env, normal)], fn posToPtParallelToNormal =>
385 :     letPRIM("perpPosToP", IR.T_VEC, IR.SUB_VEC, [posToPt, posToPtParallelToNormal], fn posToPtPerpToNormal =>
386 :     letPRIM("inDiscLen", IR.T_FLOAT, IR.LEN, [posToPtPerpToNormal], fn posToPtLen =>
387 :    
388 :     letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOradGt =>
389 :     letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), posToPtLen], fn inOradEq =>
390 :     letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
391 :    
392 :     letPRIM("inIradGt", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIradGt =>
393 :     letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [posToPtLen, psvToIRVar(env, irad)], fn inIradEq =>
394 :     letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
395 :    
396 : pavelk 746 letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
397 : pavelk 987
398 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))))))))
399 :    
400 : pavelk 746 (* Simply see whether or not the distance from the center is within the
401 :     * specified bounds.
402 :     *)
403 :     | P.D_SPHERE{center, orad, irad} =>
404 :     letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn posToC =>
405 :     letPRIM("posToPtLen", IR.T_VEC, IR.LEN, [posToC], fn posToCLen =>
406 :     letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>
407 :     letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>
408 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
409 : pavelk 1060
410 :     | P.D_CYLINDER {pt1, pt2, irad, orad} =>
411 :    
412 :     (* !FIXME! Right now, we see whether or not the point is within the two planes defined
413 :     * by the endpoints of the cylinder, and then testing to see whether or not the smallest
414 :     * distance to the line segment falls within the radii. It might be faster to find the
415 :     * closest point to the line defined by the endpoints and then see whether or not the point
416 :     * is within the segment.
417 :     *)
418 :    
419 :     (* Is it in one plane *)
420 :     letPRIM("plane1Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn plane1Norm =>
421 :     letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt1)], fn posToPt1 =>
422 :     letPRIM("dot1", IR.T_FLOAT, IR.DOT, [posToPt1, plane1Norm], fn dot1Prod =>
423 :     letPRIM("inPlane1", IR.T_BOOL, IR.GT, [dot1Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane1=>
424 :    
425 :     (* Is it in another plane *)
426 :     letPRIM("plane2Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), psvToIRVar(env, pt2)], fn plane2Norm =>
427 :     letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt2)], fn posToPt2 =>
428 :     letPRIM("dot2", IR.T_FLOAT, IR.DOT, [posToPt2, plane2Norm], fn dot2Prod =>
429 :     letPRIM("inPlane2", IR.T_BOOL, IR.GT, [dot2Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane2=>
430 :    
431 :     (* Is it in both planes? *)
432 :     letPRIM("inPlanes", IR.T_BOOL, IR.AND, [inPlane1, inPlane2], fn inPlanes =>
433 :    
434 :     (* Find distance from segment *)
435 :     letPRIM("a", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn a =>
436 :     letPRIM("b", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn b =>
437 :     letPRIM("alen", IR.T_FLOAT, IR.LEN, [a], fn alen =>
438 :     letPRIM("axb", IR.T_VEC, IR.CROSS, [a, b], fn axb =>
439 :     letPRIM("axblen", IR.T_FLOAT, IR.LEN, [axb], fn axblen =>
440 :     letPRIM("dist", IR.T_FLOAT, IR.DIV, [axblen, alen], fn dist =>
441 :    
442 :     (* Is distance in both radii? *)
443 :     letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), dist], fn inOradGt =>
444 :     letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), dist], fn inOradEq =>
445 :     letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
446 :    
447 :     letPRIM("inIradGt", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, irad)], fn inIradGt =>
448 :     letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [dist, psvToIRVar(env, irad)], fn inIradEq =>
449 :     letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
450 :    
451 :     letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
452 :    
453 :     (* It's in the cylinder (tube) if it's within both radii and in both planes... *)
454 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inPlanes, inBothRad], stmt)
455 :     ))))))))))))))))))))))
456 : pavelk 746 (*
457 :     | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}
458 :     | P.D_PLANE {pt: vec3f var, normal: vec3f var}
459 :     | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}
460 :     | P.D_BOX {min: vec3f var, max: vec3f var}
461 :     | P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}
462 :     | P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
463 :     | P.D_BLOB {center: vec3f var, stddev: float var}
464 :     | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}
465 :     *)
466 : pavelk 1120 | _ => raise Fail "Cannot determine within-ness for specified vec3 domain."
467 : pavelk 746 (* end case *)
468 :     end (*end let *)
469 : pavelk 1120
470 :     fun mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) = (case d
471 :     of P.D_POINT(pt) => letPRIM(boolVar, IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, pt), var], stmt)
472 :     | P.D_BOX {min, max} =>
473 :     letPRIM("bigMin", IR.T_BOOL, IR.GT, [var, psvToIRVar(env, min)], fn bigMin =>
474 :     letPRIM("smallMax", IR.T_BOOL, IR.GT, [psvToIRVar(env, max), var], fn smallMax =>
475 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))
476 :     | _ => raise Fail "Cannot determine within-ness for specified float domain."
477 :     (* end case *))
478 : pavelk 746
479 : pavelk 1109 fun mkIntBool(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
480 : pavelk 1108 val _ = ()
481 :     in
482 :     (case d
483 :     of P.D_POINT(pt) =>
484 :    
485 :     (* Get vectors *)
486 :     letPRIM("p1ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p1var], fn p1ToPt =>
487 :     letPRIM("p2ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p2var], fn p2ToPt =>
488 :     letPRIM("p1ToP2", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn p1ToP2 =>
489 :    
490 :     (* Get distances *)
491 :     letPRIM("p1ToPtLen", IR.T_FLOAT, IR.LEN, [p1ToPt], fn p1ToPtLen =>
492 :     letPRIM("p2ToPtLen", IR.T_FLOAT, IR.LEN, [p2ToPt], fn p2ToPtLen =>
493 :     letPRIM("p1ToP2Len", IR.T_FLOAT, IR.LEN, [p1ToP2], fn p1ToP2Len =>
494 :    
495 :     (* Add & subtract ... *)
496 :     letPRIM("distSum", IR.T_FLOAT, IR.ADD, [p1ToPtLen, p2ToPtLen], fn distSum =>
497 :     letPRIM("distDiff", IR.T_FLOAT, IR.SUB, [distSum, p1ToP2Len], fn distDiff =>
498 :     letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>
499 :    
500 :     (* Do the boolean stuff... *)
501 :     letPRIM("intersect", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), distDiffAbs], k)
502 :    
503 :     )))
504 :     )))
505 :     )))
506 :    
507 :     | _ => raise Fail ("Cannot calculate intersection for specified domain")
508 :     (* end case *))
509 :    
510 :     end (* mkIntBool *)
511 :    
512 : pavelk 1109 fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
513 : pavelk 1108 val _ = ()
514 :     in
515 :     (case d
516 : pavelk 1109 of P.D_POINT(pt) => k (psvToIRVar (env, pt))
517 : pavelk 1108 | _ => raise Fail ("Cannot calculate intersection for specified domain")
518 :     (* end case *))
519 :     end (* mkIntPt *)
520 :    
521 : pavelk 746 (* Find the normal at the given position of the particle for the specified
522 :     * domain. Note, that the particle doesn't necessarily need to be on the
523 :     * domain, but if it's not then the behavior is undefined.
524 :     *)
525 : pavelk 1109 fun normAtPoint(retNorm, d, env, pos, state, k : IR.var -> particle_state -> IR.stmt) = let
526 : pavelk 746 val newNorm = IR.newParam("n", IR.T_VEC)
527 : pavelk 1109 val nextBlk = newBlockWithArgs(env, state, [newNorm], k(newNorm))
528 : pavelk 746 in
529 :     (case d
530 :     of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
531 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
532 :     | P.D_DISC{pt, normal, irad, orad} =>
533 : pavelk 1120 mkVecWithinVar("inP", env, pos, d, fn inPlane =>
534 : pavelk 746 IR.mkIF(inPlane,
535 :     (* then *)
536 :     letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
537 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk)),
538 :     (* else *)
539 :     letPRIM(retNorm,
540 :     IR.T_VEC,
541 :     IR.SCALE,
542 :     [IR.newConst("negOne", IR.C_FLOAT ~1.0), psvToIRVar(env, normal)],
543 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
544 :     )
545 :     )
546 :    
547 : pavelk 1109 | P.D_SPHERE{center, irad, orad} =>
548 : pavelk 746 letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>
549 :     letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar => k newNormVar state
550 : pavelk 1109 ))
551 : pavelk 746
552 :     | _ => raise Fail("Cannot find normal to point of specified domain.")
553 :     (* end case *))
554 :     end
555 : pavelk 769
556 : pavelk 1108 fun trExpr(expr, env, state, k : IR.var -> IR.stmt) = (case expr
557 : pavelk 1109 of P.CONSTF f => k (IR.newConst ("c", IR.C_FLOAT f))
558 : pavelk 1108
559 : pavelk 1109 | P.CONST3F v => k (IR.newConst ("c", IR.C_VEC v))
560 : pavelk 1108
561 : pavelk 1109 | P.VAR v => k (psvToIRVar (env, v))
562 : pavelk 1108
563 : pavelk 1109 | P.STATE_VAR sv => k (getIRVarForSV (sv, state))
564 : pavelk 1108
565 : pavelk 1109 | P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, k)
566 : pavelk 1108
567 : pavelk 1109 | P.GENERATEF (dom, dist) => genFloatVar("genFlt", env, dom, dist, k)
568 : pavelk 1108
569 : pavelk 1109 | P.ADD(e1, e2) =>
570 : pavelk 1108 trExpr(e1, env, state, fn e1var =>
571 :     trExpr(e2, env, state, fn e2var =>
572 :     let
573 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
574 :     val IR.V{varType=vt2, ...} = e2var
575 : pavelk 1108 in
576 :     (case (vt1, vt2)
577 :     of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.ADD, [e1var, e2var], k)
578 :     | (IR.T_VEC, IR.T_VEC) => letPRIM("addVar", IR.T_VEC, IR.ADD_VEC, [e1var, e2var], k)
579 :     | _ => raise Fail ("Type mismatch to ADD expression")
580 :     (* end case *))
581 :     end))
582 :    
583 : pavelk 1109 | P.SCALE (e1, e2) =>
584 : pavelk 1108 trExpr(e1, env, state, fn e1var =>
585 :     trExpr(e2, env, state, fn e2var =>
586 :     let
587 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
588 :     val IR.V{varType=vt2, ...} = e2var
589 : pavelk 1108 in
590 :     (case (vt1, vt2)
591 :     of (IR.T_FLOAT, IR.T_VEC) => letPRIM("scaleVar", IR.T_VEC, IR.SCALE, [e1var, e2var], k)
592 : pavelk 1130 | (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("scaleVar", IR.T_FLOAT, IR.MULT, [e1var, e2var], k)
593 :     | _ => raise Fail (String.concat["Type mismatch to SCALE expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
594 : pavelk 1108 (* end case *))
595 :     end))
596 :    
597 : pavelk 1109 | P.DIV (e1, e2) =>
598 : pavelk 1108 trExpr(e1, env, state, fn e1var =>
599 :     trExpr(e2, env, state, fn e2var =>
600 :     let
601 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
602 :     val IR.V{varType=vt2, ...} = e2var
603 : pavelk 1108 in
604 :     (case (vt1, vt2)
605 :     of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("divVar", IR.T_FLOAT, IR.DIV, [e1var, e2var], k)
606 :     | _ => raise Fail ("Type mismatch to DIV expression")
607 :     (* end case *))
608 :     end))
609 : pavelk 866
610 : pavelk 1109 | P.NEG e =>
611 : pavelk 1108 trExpr(e, env, state, fn evar =>
612 :     let
613 : pavelk 1109 val IR.V{varType, ...} = evar
614 : pavelk 1108 in
615 :     (case varType
616 : pavelk 1109 of IR.T_FLOAT => letPRIM("negVar", IR.T_FLOAT, IR.MULT, [evar, IR.newConst("negOne", IR.C_FLOAT ~1.0)], k)
617 : pavelk 1108 | IR.T_VEC => letPRIM("negVar", IR.T_VEC, IR.NEG_VEC, [evar], k)
618 :     | _ => raise Fail ("Type mismatch to NEG expression")
619 :     (* end case *))
620 :     end)
621 :    
622 : pavelk 1109 | P.DOT (e1, e2) =>
623 : pavelk 1108 trExpr(e1, env, state, fn e1var =>
624 :     trExpr(e2, env, state, fn e2var =>
625 :     let
626 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
627 :     val IR.V{varType=vt2, ...} = e2var
628 : pavelk 1108 in
629 :     (case (vt1, vt2)
630 :     of (IR.T_VEC, IR.T_VEC) => letPRIM("dotVar", IR.T_FLOAT, IR.DOT, [e1var, e2var], k)
631 :     | _ => raise Fail ("Type mismatch to DOT expression")
632 :     (* end case *))
633 :     end))
634 :    
635 : pavelk 1109 | P.CROSS (e1, e2) =>
636 : pavelk 1108 trExpr(e1, env, state, fn e1var =>
637 :     trExpr(e2, env, state, fn e2var =>
638 :     let
639 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
640 :     val IR.V{varType=vt2, ...} = e2var
641 : pavelk 1108 in
642 :     (case (vt1, vt2)
643 :     of (IR.T_VEC, IR.T_VEC) => letPRIM("crossVar", IR.T_VEC, IR.CROSS, [e1var, e2var], k)
644 :     | _ => raise Fail ("Type mismatch to CROSS expression")
645 :     (* end case *))
646 :     end))
647 :    
648 : pavelk 1109 | P.NORMALIZE e =>
649 : pavelk 1108 trExpr(e, env, state, fn evar =>
650 :     let
651 : pavelk 1109 val IR.V{varType, ...} = evar
652 : pavelk 1108 in
653 :     (case varType
654 :     of IR.T_VEC => letPRIM("normVar", IR.T_VEC, IR.NORM, [evar], k)
655 :     | _ => raise Fail ("Type mismatch to NORMALIZE expression")
656 :     (* end case *))
657 :     end)
658 :    
659 : pavelk 1109 | P.LENGTH e =>
660 : pavelk 1108 trExpr(e, env, state, fn evar =>
661 :     let
662 : pavelk 1109 val IR.V{varType, ...} = evar
663 : pavelk 1108 in
664 :     (case varType
665 :     of IR.T_VEC => letPRIM("lenVar", IR.T_VEC, IR.LEN, [evar], k)
666 :     | _ => raise Fail ("Type mismatch to LENGTH expression")
667 :     (* end case *))
668 :     end)
669 :    
670 :     (* !SPEED! We're assuming that there is an intersection here... *)
671 : pavelk 1109 | P.INTERSECT {p1, p2, d} =>
672 : pavelk 1108 trExpr(p1, env, state, fn p1var =>
673 :     trExpr(p2, env, state, fn p2var =>
674 :     let
675 : pavelk 1109 val IR.V{varType=vt1, ...} = p1var
676 :     val IR.V{varType=vt2, ...} = p2var
677 : pavelk 1108 in
678 :     (case (vt1, vt2)
679 :     of (IR.T_VEC, IR.T_VEC) => mkIntPt(env, p1var, p2var, d, k)
680 :     | _ => raise Fail("Type mismatch to INTERSECT expression")
681 :     (* end case *))
682 :     end))
683 :    
684 : pavelk 1109 | P.NORMALTO (e, d) =>
685 : pavelk 1108 trExpr(e, env, state, fn evar =>
686 :     let
687 : pavelk 1109 val IR.V{varType, ...} = evar
688 : pavelk 1108 fun cont s = k s
689 :     in
690 :     (case varType
691 : pavelk 1109 of IR.T_VEC => normAtPoint("normVar", d, env, evar, state, fn var => fn state' => k var)
692 : pavelk 1108 | _ => raise Fail("Type mismatch to NORMALTO expression")
693 :     (* end case *))
694 :     end)
695 :    
696 :     (* end case expr *))
697 : pavelk 1109
698 :     (* generate code to produce a random particle state from a domain *)
699 :     fun newParticle (sv_gens, env, state, k : particle_state -> IR.stmt) = let
700 :    
701 :     fun createVar(P.GEN{var, ...}) = let
702 :     val P.PSV.SV{name, ty, ...} = var
703 :     in
704 :     IR.newLocal("ps_" ^ name, IR.psvTyToIRTy ty, (IR.RAND, []))
705 :     end
706 :    
707 :     val newState = List.map createVar sv_gens
708 :    
709 :     fun genVar((sv_gen, var), cont) = let
710 :     val P.GEN{exp, ...} = sv_gen
711 :     val IR.V{varType, ...} = var
712 :     in
713 : pavelk 1110 (* This is kind of a hack, but it'll get optimized out. *)
714 : pavelk 1109 trExpr(exp, env, state, fn newVal => IR.mkPRIM(var, IR.COPY, [newVal], cont))
715 :     end (* genVar *)
716 :    
717 :     in
718 :     List.foldr (fn (x, y) => genVar(x, y)) (k newState) (ListPair.zipEq (sv_gens, newState))
719 :     end (* new particle *)
720 : pavelk 1108
721 :     fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
722 :     val P.EMIT{freq, sv_gens} = emit
723 : pavelk 1109 val blk = newBlock (env, state, k)
724 :     val ttl = findIRVarByName(state, "ttl")
725 : pavelk 1108 in
726 :     letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
727 : pavelk 770 IR.mkIF(isDead,
728 :     (* then *)
729 : pavelk 1109 trExpr(freq, env, state, fn t1 =>
730 : pavelk 903 letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, PSV.numDead)], fn t2 =>
731 : pavelk 770 letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
732 :     letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
733 :     letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
734 :     IR.mkIF(t3,
735 :     (* then *)
736 : pavelk 1109 newParticle (sv_gens, env, state, fn state' => retState state'),
737 : pavelk 770 (* else *)
738 :     IR.DISCARD)))))),
739 :     (* else *)
740 : pavelk 915 retState state))
741 : pavelk 770 end
742 :    
743 : pavelk 1119 (*
744 : pavelk 1120 //
745 :     fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
746 :     val P.PR{ifstmt, ...} = pred
747 :     in
748 :     case ifstmt
749 :     of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>
750 :     IR.mkIF(withinVar, thenk(state), elsek(state)))
751 :     | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
752 :     IR.mkIF(withinVar, thenk(state), elsek(state)))
753 :     end
754 : pavelk 1119 //
755 :     // fun trAct (action, env, state, k : particle_state -> IR.stmt) = let/
756 :     // val PS{pos, vel, size, ttl, color, user} = state
757 :     // in
758 :     // case action
759 :     // of P.BOUNCE{friction, resilience, cutoff, d} => let
760 :     // val blk = newBlock (env, user, k)
761 :     // val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
762 :     // in
763 :     // letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn velScale =>
764 :     // letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
765 :     // mkWithinVar("wcp", env, pos, d, fn withinCurPos =>
766 :     // mkWithinVar("wnp", env, nextPos, d, fn withinNextPos =>
767 :     // letPRIM("nwcp", IR.T_BOOL, IR.NOT, [withinCurPos], fn notWithinCurPos =>
768 :     // letPRIM("sb", IR.T_BOOL, IR.AND, [notWithinCurPos, withinNextPos], fn shouldBounce =>
769 :     // IR.mkIF(shouldBounce,
770 :     // (*then*)
771 :     // normAtPoint("n", d, env, state, fn normAtD => fn state' => let
772 :     // val PS{pos=nextPos, vel=nextVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser} = state'
773 :     // in
774 :     // letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>
775 :     // letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>
776 :     // letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>
777 :     // letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>
778 :     //
779 :     // letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>
780 :     // letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>
781 :     // letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>
782 :     //
783 :     // letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>
784 :     //
785 :     // IR.mkIF(inCutoff,
786 :     // (*then*)
787 :     // letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>
788 :     // letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
789 :     // letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
790 :     // letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
791 :     // goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
792 :     // )))),
793 :     // (*else*)
794 :     // letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
795 :     // letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
796 :     // goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
797 :     // ))
798 :     // )))))))))
799 :     // end
800 :     // ),
801 :     // (*else*)
802 :     // goto(state, blk))))))))
803 :     // end
804 :     //
805 :     // | P.ACCEL dir =>
806 :     // letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>
807 :     // letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
808 :     // k(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user = user})))
809 :     //
810 :     // | P.MOVE =>
811 :     // letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>
812 :     // letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
813 :     // k(PS{pos = newPos, vel = vel, size = size, ttl = ttl, color = color, user = user})))
814 :     //
815 :     // | P.ORBITPOINT {center, mag, maxRad} => let
816 :     // val blk = newBlock (env, user, k)
817 :     // in
818 :     // letPRIM("toCenter", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn toCenter =>
819 :     // letPRIM("dist", IR.T_FLOAT, IR.LEN, [toCenter], fn dist =>
820 :     // letPRIM("radInDist", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, maxRad)], fn radInDist =>
821 :     // IR.mkIF(radInDist,
822 :     // (* then *)
823 :     // goto(state, blk),
824 :     // (* else *)
825 :     // letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [dist, psvToIRVar(env, maxRad)], fn magRatio =>
826 :     // letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
827 :     // letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
828 :     // letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
829 :     // letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, toCenter], fn acc =>
830 :     // letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
831 :     // goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)
832 :     // ))))))))))
833 :     // end
834 :     //
835 :     //
836 :     // | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
837 :     // val blk = newBlock (env, user, k)
838 :     // in
839 :     // letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>
840 :     // letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>
841 :     // letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>
842 :     // letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>
843 :     // letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>
844 :     // letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>
845 :     // letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>
846 :     // letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>
847 :     // letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>
848 :     // letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>
849 :     // IR.mkIF(radInDist,
850 :     // (*then*)
851 :     // goto(state, blk),
852 :     // (*else*)
853 :     // letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>
854 :     // letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
855 :     // letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
856 :     // letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
857 :     // letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>
858 :     // letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>
859 :     // letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
860 :     // goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)
861 :     // )))))))
862 :     // )))))))))))
863 :     // end
864 :     //
865 :     // (* just kill it. *)
866 :     // (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, ttl = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)
867 :     // | P.DIE => IR.DISCARD
868 :     // | _ => raise Fail("Action not implemented...")
869 :     // (* end case *)
870 :     // end
871 :     *)
872 : pavelk 1120
873 :     (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
874 :     (* mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) *)
875 :     fun trPred(cond, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
876 :     fun grabVar(cond, env, state, k : IR.var -> IR.stmt) = (case cond
877 :     of P.WITHINF(d, expr) =>
878 :     trExpr(expr, env, state, fn checkMe =>
879 :     mkFloatWithinVar("wv", env, checkMe, d, k))
880 :    
881 :     | P.WITHIN3F(d, expr) =>
882 :     trExpr(expr, env, state, fn checkMe =>
883 :     mkVecWithinVar("wv", env, checkMe, d, k))
884 :    
885 :     | P.DO_INTERSECT {p1, p2, d} =>
886 :     trExpr(p1, env, state, fn p1var =>
887 :     trExpr(p2, env, state, fn p2var =>
888 :     mkIntBool(env, p1var, p2var, d, k)))
889 :    
890 :     | P.GTHAN (e1, e2) =>
891 :     trExpr(e1, env, state, fn e1var =>
892 :     trExpr(e2, env, state, fn e2var =>
893 :     letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], k)))
894 : pavelk 1129
895 : pavelk 1120 | P.AND(c1, c2) =>
896 :     grabVar(c1, env, state, fn c1Var =>
897 :     grabVar(c2, env, state, fn c2Var =>
898 :     letPRIM("andVar", IR.T_BOOL, IR.AND, [c1Var, c2Var], k)))
899 :    
900 :     | P.OR(c1, c2) =>
901 :     grabVar(c1, env, state, fn c1Var =>
902 :     grabVar(c2, env, state, fn c2Var =>
903 :     letPRIM("andVar", IR.T_BOOL, IR.OR, [c1Var, c2Var], k)))
904 :    
905 :     | P.XOR(c1, c2) =>
906 :     grabVar(c1, env, state, fn c1Var =>
907 :     grabVar(c2, env, state, fn c2Var =>
908 :     mkXOR ("xorVar", c1Var, c2Var, k)))
909 :    
910 :     | P.NOT(c) =>
911 :     grabVar(c, env, state, fn cvar =>
912 :     letPRIM("notVar", IR.T_BOOL, IR.NOT, [cvar], k))
913 :    
914 :     (* end case *))
915 :     in
916 :     grabVar(cond, env, state, fn result =>
917 :     IR.mkIF(result, thenk(state), elsek(state)))
918 :     end
919 :    
920 : pavelk 868 fun compile (P.PG{
921 : pavelk 1107 emit as P.EMIT{freq, sv_gens}, act, render,
922 :     vars, state_vars, render_vars
923 : pavelk 868 }) = let
924 : pavelk 1107 val blks = ref[]
925 : pavelk 1122
926 :     val demand = IR.getDemand(render)
927 :     fun getIRNameForSV (v as PSV.SV{name, ...}) =
928 :     (case (PSV.SVMap.find (render_vars, v))
929 :     of SOME na => let
930 :     fun inDemand n = List.exists (fn x => #1 x = "ps_" ^ n) demand
931 :     in
932 :     (* Sanity check *)
933 :     if not (inDemand na) then
934 :     raise Fail (String.concat["Variable with name ", name," marked for rendering but not in demand."])
935 :     else
936 :     "ps_" ^ na
937 :     end
938 :     | NONE => "ps_" ^ name
939 :     (* end case *))
940 :    
941 :     fun convertToIR (v as PSV.SV{ty, ...}) = IR.newParam(getIRNameForSV v, IR.psvTyToIRTy ty)
942 : pavelk 1107 val env = let
943 : pavelk 746 (* add special globals to free vars *)
944 : pavelk 1107 val pgm_vars = PSV.Set.union(PSV.Set.singleton epsilon, vars)
945 :     fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let
946 :     val x' = (case (ty, !binding)
947 :     of (PSV.T_BOOL, PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
948 :     | (PSV.T_BOOL, PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
949 :     | (PSV.T_INT, PSV.UNDEF) => IR.newGlobal(x, IR.T_INT)
950 :     | (PSV.T_INT, PSV.INT intVal) => IR.newConst(name, IR.C_INT(intVal))
951 :     | (PSV.T_FLOAT, PSV.UNDEF) => IR.newGlobal(x, IR.T_FLOAT)
952 :     | (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))
953 :     | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
954 :     | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
955 :     | _ => raise Fail("Error in setup, type mismatch between PSV vars and their binding.")
956 : pavelk 746 (* end case *))
957 : pavelk 1107 in
958 : pavelk 746 PSV.Map.insert (map, x, x')
959 : pavelk 1107 end (* ins *)
960 : pavelk 746 in
961 : pavelk 1119 TE( blks, PSV.Set.foldl insv PSV.Map.empty pgm_vars )
962 : pavelk 1107 end (* env *)
963 :    
964 : pavelk 1120 fun evalActs theAct state f = (case theAct
965 : pavelk 867 of P.SEQ(acts) => (case acts
966 : pavelk 1120 of [] => f state
967 :     | oneAct :: rest => evalActs oneAct state (fn state' => (evalActs (P.SEQ(rest)) state' f))
968 :     (* end case *))
969 :    
970 :     | P.PRED(cond, thenAct, elseAct) =>
971 :     trPred(cond, env, state,
972 :     fn state' => evalActs thenAct state' f,
973 :     fn state' => evalActs elseAct state' f
974 :     )
975 :    
976 :     | P.DIE => IR.DISCARD
977 :    
978 :     | P.ASSIGN(sv, expr) => let
979 : pavelk 1122 val PSV.SV{ty, ...} = sv
980 : pavelk 1120 fun replaceStateVar (var, []) = [var]
981 :     | replaceStateVar (var, nv :: svars) = let
982 :     val IR.V{name=nvname, ...} = nv
983 :     val IR.V{name=varname, ...} = var
984 :     in
985 :     if nvname = varname then
986 :     var :: svars
987 :     else
988 :     nv :: replaceStateVar(var, svars)
989 :     end
990 :     in
991 :     trExpr(expr, env, state, fn newVar =>
992 : pavelk 1122 letPRIM(getIRNameForSV sv, IR.psvTyToIRTy ty, IR.COPY, [newVar],
993 : pavelk 1120 fn thisVar => f (replaceStateVar(thisVar, state))))
994 :     end
995 :    
996 :     (* end case *))
997 : pavelk 868
998 :     (* The entry block is the first block of the program, or in other words, the emitter. *)
999 :     val entryBlock = newBlock (
1000 : pavelk 1091 env,
1001 : pavelk 1120 List.map convertToIR (PSV.SVSet.listItems state_vars),
1002 : pavelk 868 fn pstate => trEmitter(
1003 :     emit,
1004 :     env,
1005 :     pstate,
1006 : pavelk 1120 fn state => evalActs act state retState
1007 : pavelk 868 )
1008 :     )
1009 :    
1010 : pavelk 972 (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
1011 :    
1012 :     fun isGlobal(IR.V{scope, ...}) = (case scope
1013 :     of IR.S_GLOBAL(v) => true
1014 :     | _ => false
1015 :     (* end case *))
1016 :    
1017 :     fun extractVarMap(TE(blks, map)) = map
1018 :    
1019 : pavelk 1122 fun convertDemand (name, x) = ("ps_" ^ name, x)
1020 :    
1021 : pavelk 866 val outPgm = PSysIR.PGM {
1022 : pavelk 1107 globals = PSV.Map.filter isGlobal (extractVarMap env),
1023 : pavelk 1122 persistents = List.map convertDemand demand,
1024 : pavelk 1107 uveOptimized = false,
1025 : pavelk 972 emitter = entryBlock,
1026 : pavelk 906 physics = List.nth(!blks, 1),
1027 : pavelk 866 render = render
1028 :     }
1029 : pavelk 868
1030 : pavelk 906 val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
1031 : pavelk 868
1032 : pavelk 746 in
1033 : pavelk 905 (* IR.outputPgm(TextIO.stdErr, outPgm); *)
1034 : pavelk 1107
1035 :     (* Note: it only succeeds if we can optimize, too *)
1036 :     if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
1037 :    
1038 :     optimized
1039 : pavelk 746 end (* compile *)
1040 :    
1041 :     end (* Translate *)

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