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 905 - (view) (download)

1 : pavelk 746 (* translate.sml
2 :     *
3 :     * 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 : pavelk 866 val compile : Particles.particle_group -> 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 :     datatype particle_state = PS of {
24 : jhr 750 pos : IR.var, (* vec3 *)
25 :     vel : IR.var, (* vec3 *)
26 :     size : IR.var, (* float *)
27 :     isDead : IR.var, (* bool *)
28 : pavelk 863 color : IR.var, (* vec3 (NOTE: should be vector4) *)
29 : pavelk 900 pos2 : IR.var, (* vec3 *)
30 : pavelk 863 dummy : IR.var
31 : pavelk 746 }
32 :    
33 :     (* special PSV global variables *)
34 :     val epsilon = PSV.constf(0.00001)
35 :    
36 :     (* constants *)
37 :     val pi = 3.14159265358979
38 :    
39 :     (* dummy placeholder *)
40 :     fun dummy (state, k) =
41 : pavelk 747 IR.mkPRIM(
42 : pavelk 746 IR.newLocal(
43 :     "temp",
44 :     IR.T_BOOL,
45 :     (IR.COPY, [IR.newConst("c", IR.C_BOOL false)])
46 :     ),
47 : pavelk 747 IR.COPY,
48 :     [IR.newConst("c", IR.C_BOOL false)],
49 : pavelk 746 k state
50 :     )
51 :    
52 : pavelk 870
53 :     fun retState s = let
54 : pavelk 900 val PS{pos, vel, size, isDead, color, pos2, dummy} = s
55 : pavelk 870 in
56 : pavelk 905 IR.mkRETURN (
57 :     [pos, vel, size, isDead, color, pos2, dummy],
58 :     [IR.POS, IR.VEL, IR.SZ, IR.ISDEAD, IR.COLOR, IR.POS2, IR.DUMMY]
59 :     )
60 : pavelk 870 end
61 :    
62 : pavelk 746 (* translation environment *)
63 :     datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)
64 :    
65 : pavelk 770 fun psvToIRVar (TE(_, env), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)
66 : pavelk 746 of SOME x' => x'
67 : pavelk 770 | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
68 : pavelk 746 (* end case *))
69 :    
70 :     fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))
71 :    
72 :     (* create a block that implements the given continuation *)
73 :     fun newBlock (TE(blks, _), k : particle_state -> IR.stmt) = let
74 :     val pos = IR.newParam ("ps_pos", IR.T_VEC)
75 :     val vel = IR.newParam ("ps_vel", IR.T_VEC)
76 :     val size = IR.newParam ("ps_size", IR.T_FLOAT)
77 :     val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)
78 :     val color = IR.newParam ("ps_color", IR.T_VEC)
79 : pavelk 864 val dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)
80 : pavelk 900 val pos2 = IR.newParam ("ps_pos2", IR.T_VEC)
81 :     val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, pos2=pos2, dummy=dummy}
82 :     val blk = IR.newBlock ([pos, vel, size, isDead, color, pos2, dummy], k state)
83 : pavelk 746 in
84 :     blks := blk :: !blks;
85 :     blk
86 :     end
87 :    
88 :     fun newBlockWithArgs (TE(blks, _), args, k : particle_state -> IR.stmt) = let
89 :     val pos = IR.newParam ("ps_pos", IR.T_VEC)
90 :     val vel = IR.newParam ("ps_vel", IR.T_VEC)
91 :     val size = IR.newParam ("ps_size", IR.T_FLOAT)
92 :     val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)
93 :     val color = IR.newParam ("ps_color", IR.T_VEC)
94 : pavelk 864 val dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)
95 : pavelk 900 val pos2 = IR.newParam ("ps_pos2", IR.T_VEC)
96 :     val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, pos2=pos2, dummy = dummy}
97 : pavelk 901 val blk = IR.newBlock ([pos, vel, size, isDead, color, pos2, dummy] @ args, k state)
98 : pavelk 746 in
99 :     blks := blk :: !blks;
100 :     blk
101 :     end
102 :    
103 : pavelk 900 fun goto (PS{pos, vel, size, isDead, color, pos2, dummy}, blk) =
104 :     IR.mkGOTO(blk, [pos, vel, size, isDead, color, pos2, dummy])
105 : pavelk 746
106 : pavelk 900 fun gotoWithArgs(PS{pos, vel, size, isDead, color, pos2, dummy}, args, blk) =
107 :     IR.mkGOTO(blk, [pos, vel, size, isDead, color, pos2, dummy] @ args)
108 : pavelk 746
109 :     fun letPRIM (x, ty, p, args, body) = let
110 :     val x' = IR.newLocal(x, ty, (p, args))
111 :     in
112 :     IR.mkPRIM(x', p, args, body x')
113 :     end
114 :    
115 :     (* prim bound to state variable (S_LOCAL for now) *)
116 :     fun letSPRIM(x, ty, p, args, body) = let
117 : pavelk 862 val x' = IR.new(x, IR.S_LOCAL(ref (p, args)), ty)
118 : pavelk 746 in
119 :     IR.mkPRIM(x', p, args, body x')
120 :     end
121 :    
122 :     (* Not sure if this should be made into a primitive or not, but
123 :     * basically this creates the XOR'd value of var1 and var2 and
124 :     * stores it in result.
125 :     *)
126 :     fun mkXOR (result, var1, var2, stmt : IR.var -> IR.stmt) =
127 :     letPRIM("testOR", IR.T_BOOL, IR.OR, [var1, var2], fn testOR =>
128 :     letPRIM("testAND", IR.T_BOOL, IR.AND, [var1, var2], fn testAND =>
129 :     letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>
130 :     letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))
131 :    
132 :     (* Generates a random vector within the given domain and puts it in vecVar *)
133 :     fun genVecVar (vecVar, env, domain, stmt : IR.var -> IR.stmt) = (case domain
134 :     of P.D_POINT(pt) =>
135 :     (* Our options here are pretty limited... *)
136 :     letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
137 :    
138 :     | P.D_LINE({pt1, pt2}) =>
139 :     (* Lerp between the points. *)
140 :     letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
141 :     letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
142 :     letPRIM ("pt1s", IR.T_VEC, IR.SCALE, [randVal, psvToIRVar(env, pt1)], fn pt1ScaleVec =>
143 :     letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>
144 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
145 :    
146 : pavelk 873 | P.D_BOX{max, min} =>
147 :     (* Extract the componentwise vector variables *)
148 :     letPRIM("minX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, min)], fn minX =>
149 :     letPRIM("maxX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, max)], fn maxX =>
150 :     letPRIM("minY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, min)], fn minY =>
151 :     letPRIM("maxY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, max)], fn maxY =>
152 :     letPRIM("minZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, min)], fn minZ =>
153 :     letPRIM("maxZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, max)], fn maxZ =>
154 :    
155 :     (* Find the distance in each component *)
156 :     letPRIM("distX", IR.T_FLOAT, IR.SUB, [maxX, minX], fn distX =>
157 :     letPRIM("distY", IR.T_FLOAT, IR.SUB, [maxY, minY], fn distY =>
158 :     letPRIM("distZ", IR.T_FLOAT, IR.SUB, [maxZ, minZ], fn distZ =>
159 :    
160 :     (* Get three random numbers for each of the components *)
161 :     letPRIM("randX", IR.T_FLOAT, IR.RAND, [], fn randX =>
162 :     letPRIM("randY", IR.T_FLOAT, IR.RAND, [], fn randY =>
163 :     letPRIM("randZ", IR.T_FLOAT, IR.RAND, [], fn randZ =>
164 :    
165 :     (* Scale the distances by these random numbers *)
166 :     letPRIM("scaledX", IR.T_FLOAT, IR.MULT, [randX, distX], fn scaledX =>
167 :     letPRIM("scaledY", IR.T_FLOAT, IR.MULT, [randY, distY], fn scaledY =>
168 :     letPRIM("scaledZ", IR.T_FLOAT, IR.MULT, [randZ, distZ], fn scaledZ =>
169 :    
170 :     (* Add them to the minimum vec in order to create a new vec inside
171 :     * of the box.
172 :     *)
173 :     letPRIM("newX", IR.T_FLOAT, IR.ADD, [minX, scaledX], fn newX =>
174 :     letPRIM("newY", IR.T_FLOAT, IR.ADD, [minY, scaledY], fn newY =>
175 :     letPRIM("newZ", IR.T_FLOAT, IR.ADD, [minZ, scaledZ], fn newZ =>
176 :    
177 :     (* Gen the vector *)
178 :     letPRIM(vecVar, IR.T_VEC, IR.GEN_VEC, [newX, newY, newZ], stmt
179 :    
180 :     )))))))))))))))))))
181 :    
182 : pavelk 746
183 :     | P.D_TRIANGLE{pt1, pt2, pt3} =>
184 :     letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>
185 :     letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>
186 :     letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
187 :     letPRIM ("randTwo", IR.T_FLOAT, IR.RAND, [], fn rand2 =>
188 :     letPRIM ("randTwoInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), rand2], fn rand2Inv =>
189 :     letPRIM ("scaleOne", IR.T_VEC, IR.SCALE, [rand1, pt1ToPt2], fn scale1 =>
190 :     letPRIM ("nextScale1", IR.T_VEC, IR.SCALE, [rand2Inv, scale1], fn nextScale1 =>
191 :     letPRIM ("scaleTwo", IR.T_VEC, IR.SCALE, [rand2, pt1ToPt3], fn scale2 =>
192 :     letPRIM ("tempAdd", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, pt1), nextScale1], fn tempAdd =>
193 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [tempAdd, scale2], stmt))))))))))
194 :    
195 :     | P.D_CYLINDER {pt1, pt2, irad, orad} => let
196 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
197 :     in
198 :     letPRIM("rand", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
199 :     letPRIM("n", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
200 :     letPRIM("ht", IR.T_FLOAT, IR.LEN, [normVec], fn height =>
201 :     letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>
202 :     letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
203 :     (* Generate a point in the lower disc. *)
204 :     genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>
205 :     (* Now add this point to a random scaling of the normVec. *)
206 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
207 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
208 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
209 :     end
210 :    
211 :     | P.D_DISC {pt, normal, irad, orad} =>
212 :     (* Get a random angle... *)
213 :     letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
214 :     letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>
215 :     (* Get a random radius *)
216 :     letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
217 :     letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>
218 :     letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
219 :     letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
220 :     letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>
221 :     (* Find a vector in the plane of the disc, and then
222 :     * translate it to the center.
223 :     *)
224 :     letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>
225 :     letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>
226 :     letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>
227 :     letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>
228 :     letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>
229 :     (* Figure out x and y values for our new radius and angle *)
230 :     letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>
231 :     letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>
232 :     letPRIM ("rv1", IR.T_VEC, IR.SCALE, [amtVecOne, vecInDiscNorm], fn resVecOne =>
233 :     letPRIM ("ry", IR.T_FLOAT, IR.SIN, [randAng], fn radY =>
234 :     letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>
235 :     letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>
236 :     letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>
237 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt))))))))))))))))))))
238 :    
239 :     | P.D_CONE{pt1, pt2, irad, orad} => let
240 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
241 :     in
242 :     letPRIM("eh", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
243 :     letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
244 :     letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
245 :     genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>
246 :     letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>
247 :     letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
248 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
249 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>
250 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
251 :     end
252 :    
253 :     | _ => raise Fail "Cannot generate point in specified domain."
254 :     (* end case *))
255 :     (*
256 :     | generate (Dplane{pt, n}) = Vec3f.unpack pt
257 :     | generate (Drectangle{pt, u, v}) = Vec3f.unpack pt
258 :     | generate (Dsphere{c, orad, irad}) = Vec3f.unpack c
259 :     | generate (Dblob{c, stddev}) = Vec3f.unpack c
260 :     *)
261 :    
262 :    
263 :     (* This function takes an IR boolean, its environment, a particle state, domain,
264 :     * and continuation.
265 :     *
266 :     * We set the boolean to whether or not the current particle given by the particle
267 :     * state is within the domain, and then pass the continuation on.
268 :     *)
269 : pavelk 770 fun mkWithinVar (boolVar, env, var, d, stmt : IR.var -> IR.stmt) = let
270 :     val pos = var
271 : pavelk 746 in
272 :     case d
273 :     of P.D_POINT(pt) =>
274 :     letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn subVec =>
275 :     letPRIM("vecLen", IR.T_FLOAT, IR.LEN, [subVec], fn vecLen =>
276 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), vecLen], stmt)))
277 :    
278 :     (* Take the vectors going from our position to pt1, and pt2. Then
279 :     * after we normalize them, if their dot product is equal to -1, then
280 :     * they are pointing in opposite directions meaning that the position
281 :     * is inbetween pt1 and pt2 as desired.
282 :     *)
283 :     | P.D_LINE{pt1, pt2} =>
284 :     letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn posToPt1 =>
285 :     letPRIM("posToPt1Norm", IR.T_VEC, IR.NORM, [posToPt1], fn posToPt1Norm =>
286 :     letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), pos], fn posToPt2 =>
287 :     letPRIM("posToPt2Norm", IR.T_VEC, IR.NORM, [posToPt2], fn posToPt2Norm =>
288 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt2, posToPt1], fn dotProd =>
289 :     letPRIM("testMe", IR.T_FLOAT, IR.SUB, [dotProd, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn testVal =>
290 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), testVal], stmt)))))))
291 :    
292 :     (* Just see whether or not the dot product between the normal
293 :     * and the vector from a point on the plane to our position is
294 :     * greater than zero. Essentially, we're "within" a plane if we're
295 :     * behind it (with respect to the normal)
296 :     *)
297 :     | P.D_PLANE{pt, normal} =>
298 : pavelk 905 letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
299 : pavelk 746 letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
300 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))
301 :    
302 :     (* Similar to checking to see whether or not we're within a plane,
303 :     * here all we have to do is see how far we are from the center
304 :     * of the disc (pt), and then see whther or not we're perpendicular to
305 :     * the normal, and that our distance is greater than irad but less than
306 :     * orad.
307 :     *)
308 :     | P.D_DISC{pt, normal, orad, irad} =>
309 :     letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn posToPt =>
310 :     letPRIM("posToPtLen", IR.T_FLOAT, IR.LEN, [posToPt], fn posToPtLen =>
311 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
312 :     letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>
313 :     letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOrad =>
314 :     letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIrad =>
315 :     letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
316 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))
317 :    
318 :     (* Simply see whether or not the distance from the center is within the
319 :     * specified bounds.
320 :     *)
321 :     | P.D_SPHERE{center, orad, irad} =>
322 :     letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn posToC =>
323 :     letPRIM("posToPtLen", IR.T_VEC, IR.LEN, [posToC], fn posToCLen =>
324 :     letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>
325 :     letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>
326 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
327 :     (*
328 :     | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}
329 :     | P.D_PLANE {pt: vec3f var, normal: vec3f var}
330 :     | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}
331 :     | P.D_BOX {min: vec3f var, max: vec3f var}
332 :     | P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}
333 :     | P.D_CYLINDER {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
334 :     | P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
335 :     | P.D_BLOB {center: vec3f var, stddev: float var}
336 :     | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}
337 :     *)
338 :     | _ => raise Fail "Cannot determine within-ness for specified domain."
339 :     (* end case *)
340 :     end (*end let *)
341 :    
342 :    
343 :     (* generate code to produce a random particle state from a domain *)
344 :     fun newParticle (posDomain, velDomain, colDomain, env, k : particle_state -> IR.stmt) =
345 :     (* genVecVar (vecVar, env, domain, stmt) *)
346 :     genVecVar("ps_pos", env, posDomain, fn newPos =>
347 :     genVecVar("ps_vel", env, velDomain, fn newVel =>
348 :     genVecVar("ps_col", env, colDomain, fn newCol =>
349 :     letSPRIM ("ps_size", IR.T_FLOAT, IR.RAND, [], fn newSize =>
350 :     letSPRIM ("ps_isDead", IR.T_BOOL, IR.COPY, [IR.newConst("fbool", IR.C_BOOL false)], fn newIsDead =>
351 : pavelk 873 k(PS{pos = newPos,
352 :     vel = newVel,
353 :     size = newSize,
354 :     isDead = newIsDead,
355 : pavelk 900 color = newCol,
356 : pavelk 905 pos2 = IR.newConst("ps_pos2", IR.C_VEC {x=0.0, y=0.0, z=0.0}),
357 :     dummy = IR.newConst("ps_dummy", IR.C_FLOAT 0.01)})
358 : pavelk 873 )))))
359 : pavelk 746
360 :     (* Find the normal at the given position of the particle for the specified
361 :     * domain. Note, that the particle doesn't necessarily need to be on the
362 :     * domain, but if it's not then the behavior is undefined.
363 :     *)
364 :     fun normAtPoint(retNorm, d, env, state, k : IR.var -> particle_state -> IR.stmt) = let
365 :     val newNorm = IR.newParam("n", IR.T_VEC)
366 :     val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))
367 : pavelk 770 val PS{pos, ...} = state
368 : pavelk 746 in
369 :     (case d
370 :     of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
371 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
372 :     | P.D_DISC{pt, normal, irad, orad} =>
373 : pavelk 770 mkWithinVar("inP", env, pos, d, fn inPlane =>
374 : pavelk 746 IR.mkIF(inPlane,
375 :     (* then *)
376 :     letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
377 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk)),
378 :     (* else *)
379 :     letPRIM(retNorm,
380 :     IR.T_VEC,
381 :     IR.SCALE,
382 :     [IR.newConst("negOne", IR.C_FLOAT ~1.0), psvToIRVar(env, normal)],
383 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
384 :     )
385 :     )
386 :    
387 :     | P.D_SPHERE{center, irad, orad} => let
388 : pavelk 870 val PS{pos, ...} = state
389 : pavelk 746 in
390 :     letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>
391 :     letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar => k newNormVar state
392 :     ))
393 :     end
394 :    
395 :     | _ => raise Fail("Cannot find normal to point of specified domain.")
396 :     (* end case *))
397 :     end
398 : pavelk 769
399 : pavelk 770 fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
400 : pavelk 866
401 : pavelk 870 val PS{isDead, ...} = state
402 : pavelk 770 val P.EMIT{maxNum, posDomain, velDomain, colDomain, ...} = emit
403 :     val blk = newBlock (env, k)
404 :     in
405 :     IR.mkIF(isDead,
406 :     (* then *)
407 :     letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>
408 : pavelk 903 letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, PSV.numDead)], fn t2 =>
409 : pavelk 770 letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
410 :     letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
411 :     letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
412 :     IR.mkIF(t3,
413 :     (* then *)
414 :     newParticle (posDomain, velDomain, colDomain, env,
415 : pavelk 866 fn state' => retState state'),
416 : pavelk 770 (* else *)
417 :     IR.DISCARD)))))),
418 :     (* else *)
419 : pavelk 870 retState state)
420 : pavelk 770 end
421 :    
422 : pavelk 769 fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
423 : pavelk 870 val PS{pos, vel, ...} = state
424 : pavelk 769 val P.PR{ifstmt, ...} = pred
425 :     in
426 :     case ifstmt
427 : pavelk 770 of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>
428 : pavelk 867 IR.mkIF(withinVar, thenk(state), elsek(state)))
429 : pavelk 770 | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
430 : pavelk 867 IR.mkIF(withinVar, thenk(state), elsek(state)))
431 : pavelk 769 end
432 :    
433 : pavelk 746 fun trAct (action, env, state, k : particle_state -> IR.stmt) = let
434 : pavelk 900 val PS{pos, vel, size, isDead, color, pos2, dummy} = state
435 : pavelk 746 in
436 :     case action
437 :     of P.BOUNCE{friction, resilience, cutoff, d} => let
438 :     val blk = newBlock (env, k)
439 :     val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
440 :     in
441 : pavelk 903 letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn velScale =>
442 : pavelk 746 letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
443 : pavelk 770 mkWithinVar("wnp", env, pos, d, fn withinNextPos =>
444 : pavelk 746 IR.mkIF(withinNextPos,
445 :     (*then*)
446 :     normAtPoint("n", d, env, state, fn normAtD => fn state' => let
447 : pavelk 900 val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy} = state'
448 : pavelk 746 in
449 :     letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>
450 :     letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>
451 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>
452 :     letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>
453 :    
454 :     letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>
455 :     letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>
456 :     letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>
457 :    
458 :     letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>
459 :    
460 :     IR.mkIF(inCutoff,
461 :     (*then*)
462 :     letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>
463 :     letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
464 :     letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
465 :     letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
466 : pavelk 900 goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy}, blk)
467 : pavelk 746 )))),
468 :     (*else*)
469 :     letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
470 : pavelk 902 letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
471 : pavelk 900 goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy}, blk)
472 : pavelk 746 ))
473 :     )))))))))
474 :     end
475 :     ),
476 :     (*else*)
477 :     goto(state, blk)))))
478 :     end
479 :    
480 :     | P.GRAVITY(dir) =>
481 : pavelk 903 letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>
482 : pavelk 902 letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
483 : pavelk 900 k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, pos2=pos2, dummy=dummy})))
484 : pavelk 746
485 :     | P.MOVE =>
486 : pavelk 903 letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>
487 : pavelk 902 letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
488 : pavelk 900 k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color, pos2=pos2, dummy=dummy})))
489 : pavelk 770 (*
490 : pavelk 758 | P.SINK({d, kill_inside}) =>
491 : pavelk 746 mkWithinVar("isWithin", env, state, d, fn withinVal =>
492 :     mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),
493 :     fn shouldNotKill =>
494 : pavelk 758 letPRIM("shouldKill", IR.T_BOOL, IR.NOT, [shouldNotKill], fn shouldKill =>
495 :     letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, isDead], fn isReallyDead =>
496 :     k(PS{pos = pos, vel = vel, size = size, isDead = isReallyDead, color = color})
497 :     ))))
498 : pavelk 770 *)
499 : pavelk 746
500 :     | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
501 :     val blk = newBlock (env, k)
502 :     in
503 :     letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>
504 :     letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>
505 :     letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>
506 :     letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>
507 :     letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>
508 :     letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>
509 :     letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>
510 :     letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>
511 :     letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>
512 :     letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>
513 :     IR.mkIF(radInDist,
514 :     (*then*)
515 :     goto(state, blk),
516 :     (*else*)
517 :     letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>
518 :     letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
519 :     letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
520 : pavelk 903 letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
521 : pavelk 746 letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>
522 :     letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>
523 : pavelk 902 letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
524 : pavelk 900 goto(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, pos2=pos2, dummy=dummy}, blk)
525 : pavelk 746 )))))))
526 :     )))))))))))
527 :     end
528 : pavelk 770
529 :     (* just kill it. *)
530 : pavelk 870 (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, isDead = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)
531 :     | P.DIE => IR.DISCARD
532 : pavelk 746 | _ => raise Fail("Action not implemented...")
533 :     (* end case *)
534 :     end
535 :    
536 : pavelk 868 fun compile (P.PG{
537 :     emit as P.EMIT{maxNum, vars=emitVars, ...},
538 :     act as P.PSAE{action=root_act, vars=actionVars},
539 :     render
540 :     }) = let
541 : pavelk 746 val blks = ref[]
542 :     val env = let
543 :     (* add special globals to free vars *)
544 : pavelk 903 val vars = PSV.Set.union(emitVars, PSV.Set.addList(actionVars, [maxNum, PSV.numDead, PSV.timeStep, epsilon]))
545 : pavelk 770 fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let
546 : pavelk 746 val x' = (case (ty, !binding)
547 :     of (PSV.T_BOOL, PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
548 :     | (PSV.T_BOOL, PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
549 :     | (PSV.T_INT, PSV.UNDEF) => IR.newGlobal(x, IR.T_INT)
550 :     | (PSV.T_INT, PSV.INT intVal) => IR.newConst(name, IR.C_INT(intVal))
551 :     | (PSV.T_FLOAT, PSV.UNDEF) => IR.newGlobal(x, IR.T_FLOAT)
552 :     | (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))
553 :     | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
554 :     | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
555 :     | _ => raise Fail("Error in setup, type mismatch between IR and PSV vars.")
556 :     (* end case *))
557 :     in
558 :     PSV.Map.insert (map, x, x')
559 :     end
560 :     in
561 :     TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)
562 :     end
563 : pavelk 867
564 : pavelk 868
565 : pavelk 905 fun evalActs f [] state = f [] state
566 : pavelk 867 | evalActs f (psa :: psal) state = (case psa
567 :     of P.SEQ(acts) => (case acts
568 :     of [] => raise Fail "Should never reach here."
569 :     | [act] => trAct(act, env, state, evalActs f psal)
570 :     | act :: rest => trAct(act, env, state, evalActs f (P.SEQ(rest) :: psal))
571 :     (* end case *))
572 :     | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) => let
573 :     val cblk = newBlock(env, evalActs f psal)
574 :     fun trPredActs [] state' = goto(state', cblk)
575 :     | trPredActs _ _ = raise Fail "Should never reach here."
576 :     in
577 :     trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)
578 :     end
579 :     (* end case *))
580 :    
581 : pavelk 868 (* At the highest level, we want to return when we reach the end of the action list *)
582 : pavelk 746 fun trActs [] state = let
583 : pavelk 900 val PS{pos, vel, size, isDead, color, pos2, dummy} = state
584 : pavelk 746 in
585 : pavelk 905 IR.mkRETURN (
586 :     [ pos, vel, size, isDead, color, pos2, dummy ],
587 :     [IR.POS, IR.VEL, IR.SZ, IR.ISDEAD, IR.COLOR, IR.POS2, IR.DUMMY]
588 :     )
589 : pavelk 746 end (* trActs *)
590 : pavelk 867 | trActs _ _ = raise Fail "Should never reach here"
591 : pavelk 868
592 :     (* The entry block is the first block of the program, or in other words, the emitter. *)
593 :     val entryBlock = newBlock (
594 :     env,
595 :     fn pstate => trEmitter(
596 :     emit,
597 :     env,
598 :     pstate,
599 :     fn state => evalActs trActs root_act state
600 :     )
601 :     )
602 :    
603 :     (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
604 : pavelk 866 val outPgm = PSysIR.PGM {
605 :     emitter = entryBlock,
606 :     physics = List.drop(!blks, 1),
607 :     render = render
608 :     }
609 : pavelk 868
610 :     val optimized = if (Checker.checkIR(outPgm)) then Optimize.optimizeIR(outPgm) else outPgm
611 :    
612 : pavelk 746 in
613 : pavelk 905 (* IR.outputPgm(TextIO.stdErr, outPgm); *)
614 : pavelk 868 if Checker.checkIR(optimized) then
615 :     printErr "Compilation succeeded." (* Note: it only succeeds if we can optimize, too *)
616 : pavelk 746 else
617 : pavelk 866 ();
618 : pavelk 868 optimized
619 : pavelk 746 end (* compile *)
620 :    
621 :     end (* Translate *)

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