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 1091 - (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 : 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 :     datatype particle_state = PS of {
24 : pavelk 1091 pos : IR.var, (* vec3 *)
25 :     vel : IR.var, (* vec3 *)
26 :     size : IR.var, (* float *)
27 :     ttl : IR.var, (* float *)
28 :     color : IR.var, (* vec3 (NOTE: should be vector4) *)
29 :     user : IR.var list
30 :     }
31 : pavelk 746
32 :     (* special PSV global variables *)
33 :     val epsilon = PSV.constf(0.00001)
34 :    
35 :     (* constants *)
36 :     val pi = 3.14159265358979
37 : pavelk 870
38 : pavelk 1091 fun constructUserDefs([]) = []
39 :     | constructUserDefs(IR.V{id, ...} :: users) =
40 :     (IR.USER_DEF id) :: constructUserDefs(users)
41 :    
42 :     fun userVarsFromState(PS{user, ...}) = user
43 :     fun userVarsFromEmit(P.EMIT{...}) = []
44 :    
45 : pavelk 870 fun retState s = let
46 : pavelk 1091 val PS{pos, vel, size, ttl, color, user} = s
47 : pavelk 870 in
48 : pavelk 905 IR.mkRETURN (
49 : pavelk 1091 [pos, vel, size, ttl, color] @ user,
50 :     [IR.POS, IR.VEL, IR.SZ, IR.TTL, IR.COLOR] @ constructUserDefs(user)
51 : pavelk 905 )
52 : pavelk 870 end
53 :    
54 : pavelk 746 (* translation environment *)
55 :     datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)
56 :    
57 : pavelk 770 fun psvToIRVar (TE(_, env), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)
58 : pavelk 746 of SOME x' => x'
59 : pavelk 770 | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
60 : pavelk 746 (* end case *))
61 :    
62 :     fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))
63 :    
64 :     (* create a block that implements the given continuation *)
65 : pavelk 1091
66 :     fun createUserVarCopies( [ ], _ ) = [ ]
67 :     | createUserVarCopies( IR.V{varType, ...} :: vars, i) =
68 :     IR.newParam ("ps_user" ^ (Int.toString i), varType) :: (createUserVarCopies(vars, i+1))
69 :    
70 :     fun newBlock (TE(blks, _), userVars, k : particle_state -> IR.stmt) = let
71 : pavelk 746 val pos = IR.newParam ("ps_pos", IR.T_VEC)
72 :     val vel = IR.newParam ("ps_vel", IR.T_VEC)
73 :     val size = IR.newParam ("ps_size", IR.T_FLOAT)
74 : pavelk 915 val ttl = IR.newParam ("ps_ttl", IR.T_FLOAT)
75 : pavelk 746 val color = IR.newParam ("ps_color", IR.T_VEC)
76 : pavelk 1091 val userVarCopies = createUserVarCopies(userVars, 0)
77 :     val state = PS{pos=pos, vel=vel, size=size, ttl=ttl, color=color, user=userVarCopies}
78 :     val blk = IR.newBlock ([pos, vel, size, ttl, color] @ userVarCopies, k state)
79 : pavelk 746 in
80 :     blks := blk :: !blks;
81 :     blk
82 :     end
83 :    
84 : pavelk 1091 fun newBlockWithArgs (TE(blks, _), userVars, args, k : particle_state -> IR.stmt) = let
85 : pavelk 746 val pos = IR.newParam ("ps_pos", IR.T_VEC)
86 :     val vel = IR.newParam ("ps_vel", IR.T_VEC)
87 :     val size = IR.newParam ("ps_size", IR.T_FLOAT)
88 : pavelk 915 val ttl = IR.newParam ("ps_ttl", IR.T_FLOAT)
89 : pavelk 746 val color = IR.newParam ("ps_color", IR.T_VEC)
90 : pavelk 1027 val rot = IR.newParam("ps_rot", IR.T_FLOAT)
91 : pavelk 1091 val userVarCopies = createUserVarCopies(userVars, 0)
92 :     val state = PS{pos=pos, vel=vel, size=size, ttl=ttl, color=color, user = userVarCopies}
93 :     val blk = IR.newBlock (List.concat[[pos, vel, size, ttl, color], userVarCopies, args], k state)
94 : pavelk 746 in
95 :     blks := blk :: !blks;
96 :     blk
97 :     end
98 :    
99 : pavelk 1091 fun goto (PS{pos, vel, size, ttl, color, user}, blk) =
100 :     IR.mkGOTO(blk, [pos, vel, size, ttl, color] @ user)
101 : pavelk 746
102 : pavelk 1091 fun gotoWithArgs(PS{pos, vel, size, ttl, color, user}, args, blk) =
103 :     IR.mkGOTO(blk, List.concat[[pos, vel, size, ttl, color], user, args])
104 : pavelk 746
105 :     fun letPRIM (x, ty, p, args, body) = let
106 :     val x' = IR.newLocal(x, ty, (p, args))
107 :     in
108 :     IR.mkPRIM(x', p, args, body x')
109 :     end
110 :    
111 :     (* prim bound to state variable (S_LOCAL for now) *)
112 :     fun letSPRIM(x, ty, p, args, body) = let
113 : pavelk 862 val x' = IR.new(x, IR.S_LOCAL(ref (p, args)), ty)
114 : pavelk 746 in
115 :     IR.mkPRIM(x', p, args, body x')
116 :     end
117 :    
118 :     (* Not sure if this should be made into a primitive or not, but
119 :     * basically this creates the XOR'd value of var1 and var2 and
120 :     * stores it in result.
121 :     *)
122 :     fun mkXOR (result, var1, var2, stmt : IR.var -> IR.stmt) =
123 :     letPRIM("testOR", IR.T_BOOL, IR.OR, [var1, var2], fn testOR =>
124 :     letPRIM("testAND", IR.T_BOOL, IR.AND, [var1, var2], fn testAND =>
125 :     letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>
126 :     letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))
127 :    
128 : pavelk 1017 fun genFloatVar (fltVar, env, domain : Float.float P.domain, dist, stmt : IR.var -> IR.stmt) = let
129 :     fun genRandVal(var, stmt : IR.var -> IR.stmt) = (case dist
130 :     of P.DIST_UNIFORM =>
131 :     letPRIM(var, IR.T_FLOAT, IR.RAND, [], stmt)
132 :    
133 :     (* The PDF here is f(x) = 2x when 0 < x <= 1, so the CDF is going
134 :     * to be the integral of f from 0 -> y => y^2. Hence, whenever we
135 :     * generate a random number, in order to get the random value according
136 :     * to this probability distribution, we just square it.
137 :     *)
138 :     | P.DIST_INC_LIN =>
139 :     letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
140 :     letPRIM(var, IR.T_FLOAT, IR.MULT, [randVal, randVal], stmt))
141 :    
142 :     (* The PDF here is f(x) = -2x + 2 when 0 <= x < 1, so the CDF is going
143 :     * to be the integral of f from 0 -> y => -(y^2) + 2y. Hence, whenever we
144 :     * generate a random number, in order to get the random value according
145 :     * to this probability distribution, we just square it.
146 :     *)
147 :     | P.DIST_DEC_LIN =>
148 :     letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
149 :     letPRIM("randSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randSq =>
150 :     letPRIM("termOne", IR.T_FLOAT, IR.MULT, [randSq, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn termOne =>
151 :     letPRIM("termTwo", IR.T_FLOAT, IR.MULT, [randVal, IR.newConst("negOne", IR.C_FLOAT 2.0)], fn termTwo =>
152 :     letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)
153 :     ))))
154 :    
155 :     | _ => raise Fail "Unable to create random float for specified distribution."
156 :     (* end case *))
157 :     in
158 :     (case domain
159 :     of P.D_POINT(pt) =>
160 :     (* Our options here are pretty limited... *)
161 :     letPRIM (fltVar, IR.T_FLOAT, IR.COPY, [psvToIRVar(env, pt)], stmt)
162 :    
163 :     | P.D_BOX{max, min} =>
164 :     genRandVal("randf", fn rand =>
165 :     letPRIM("boxDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, max), psvToIRVar(env, max)], fn diff =>
166 :     letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>
167 :     letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )
168 :     )))
169 :     | _ => raise Fail "Cannot generate float in specified domain."
170 :     (* end case *))
171 :     end
172 :    
173 : pavelk 746 (* Generates a random vector within the given domain and puts it in vecVar *)
174 : pavelk 1017 fun genVecVar (vecVar, env, domain : Vec3f.vec3 P.domain, stmt : IR.var -> IR.stmt) = (case domain
175 : pavelk 746 of P.D_POINT(pt) =>
176 :     (* Our options here are pretty limited... *)
177 :     letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
178 :    
179 :     | P.D_LINE({pt1, pt2}) =>
180 :     (* Lerp between the points. *)
181 :     letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
182 :     letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
183 :     letPRIM ("pt1s", IR.T_VEC, IR.SCALE, [randVal, psvToIRVar(env, pt1)], fn pt1ScaleVec =>
184 :     letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>
185 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
186 :    
187 : pavelk 873 | P.D_BOX{max, min} =>
188 :     (* Extract the componentwise vector variables *)
189 :     letPRIM("minX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, min)], fn minX =>
190 :     letPRIM("maxX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, max)], fn maxX =>
191 :     letPRIM("minY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, min)], fn minY =>
192 :     letPRIM("maxY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, max)], fn maxY =>
193 :     letPRIM("minZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, min)], fn minZ =>
194 :     letPRIM("maxZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, max)], fn maxZ =>
195 :    
196 :     (* Find the distance in each component *)
197 :     letPRIM("distX", IR.T_FLOAT, IR.SUB, [maxX, minX], fn distX =>
198 :     letPRIM("distY", IR.T_FLOAT, IR.SUB, [maxY, minY], fn distY =>
199 :     letPRIM("distZ", IR.T_FLOAT, IR.SUB, [maxZ, minZ], fn distZ =>
200 :    
201 :     (* Get three random numbers for each of the components *)
202 :     letPRIM("randX", IR.T_FLOAT, IR.RAND, [], fn randX =>
203 :     letPRIM("randY", IR.T_FLOAT, IR.RAND, [], fn randY =>
204 :     letPRIM("randZ", IR.T_FLOAT, IR.RAND, [], fn randZ =>
205 :    
206 :     (* Scale the distances by these random numbers *)
207 :     letPRIM("scaledX", IR.T_FLOAT, IR.MULT, [randX, distX], fn scaledX =>
208 :     letPRIM("scaledY", IR.T_FLOAT, IR.MULT, [randY, distY], fn scaledY =>
209 :     letPRIM("scaledZ", IR.T_FLOAT, IR.MULT, [randZ, distZ], fn scaledZ =>
210 :    
211 :     (* Add them to the minimum vec in order to create a new vec inside
212 :     * of the box.
213 :     *)
214 :     letPRIM("newX", IR.T_FLOAT, IR.ADD, [minX, scaledX], fn newX =>
215 :     letPRIM("newY", IR.T_FLOAT, IR.ADD, [minY, scaledY], fn newY =>
216 :     letPRIM("newZ", IR.T_FLOAT, IR.ADD, [minZ, scaledZ], fn newZ =>
217 :    
218 :     (* Gen the vector *)
219 :     letPRIM(vecVar, IR.T_VEC, IR.GEN_VEC, [newX, newY, newZ], stmt
220 :    
221 :     )))))))))))))))))))
222 :    
223 : pavelk 746
224 :     | P.D_TRIANGLE{pt1, pt2, pt3} =>
225 :     letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>
226 :     letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>
227 :     letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
228 :     letPRIM ("randTwo", IR.T_FLOAT, IR.RAND, [], fn rand2 =>
229 :     letPRIM ("randTwoInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), rand2], fn rand2Inv =>
230 :     letPRIM ("scaleOne", IR.T_VEC, IR.SCALE, [rand1, pt1ToPt2], fn scale1 =>
231 :     letPRIM ("nextScale1", IR.T_VEC, IR.SCALE, [rand2Inv, scale1], fn nextScale1 =>
232 :     letPRIM ("scaleTwo", IR.T_VEC, IR.SCALE, [rand2, pt1ToPt3], fn scale2 =>
233 :     letPRIM ("tempAdd", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, pt1), nextScale1], fn tempAdd =>
234 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [tempAdd, scale2], stmt))))))))))
235 :    
236 :     | P.D_CYLINDER {pt1, pt2, irad, orad} => let
237 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
238 :     in
239 :     letPRIM("rand", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
240 :     letPRIM("n", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
241 :     letPRIM("ht", IR.T_FLOAT, IR.LEN, [normVec], fn height =>
242 :     letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>
243 :     letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
244 :     (* Generate a point in the lower disc. *)
245 :     genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>
246 :     (* Now add this point to a random scaling of the normVec. *)
247 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
248 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
249 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
250 :     end
251 :    
252 :     | P.D_DISC {pt, normal, irad, orad} =>
253 :     (* Get a random angle... *)
254 :     letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
255 :     letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>
256 :     (* Get a random radius *)
257 :     letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
258 :     letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>
259 :     letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
260 :     letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
261 :     letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>
262 :     (* Find a vector in the plane of the disc, and then
263 :     * translate it to the center.
264 :     *)
265 :     letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>
266 :     letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>
267 :     letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>
268 :     letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>
269 :     letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>
270 :     (* Figure out x and y values for our new radius and angle *)
271 :     letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>
272 :     letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>
273 :     letPRIM ("rv1", IR.T_VEC, IR.SCALE, [amtVecOne, vecInDiscNorm], fn resVecOne =>
274 :     letPRIM ("ry", IR.T_FLOAT, IR.SIN, [randAng], fn radY =>
275 :     letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>
276 :     letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>
277 :     letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>
278 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt))))))))))))))))))))
279 :    
280 :     | P.D_CONE{pt1, pt2, irad, orad} => let
281 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
282 :     in
283 :     letPRIM("eh", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
284 :     letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
285 :     letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
286 :     genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>
287 :     letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>
288 :     letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
289 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
290 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>
291 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
292 :     end
293 : pavelk 1074
294 :     | P.D_SPHERE{center, irad, orad} =>
295 :    
296 :     (* generate two random angles... *)
297 :     letPRIM("r1", IR.T_FLOAT, IR.RAND, [], fn randForAngOne =>
298 :     letPRIM("t1", IR.T_FLOAT, IR.MULT, [randForAngOne, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngOne =>
299 :     letPRIM("r2", IR.T_FLOAT, IR.RAND, [], fn randForAngTwo =>
300 :     letPRIM("t2", IR.T_FLOAT, IR.MULT, [randForAngTwo, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngTwo =>
301 :    
302 :     (* Generate vector in the sphere ... *)
303 :     (* If my math is correct this should be
304 :     * <(cos t1)(cos t2), (sin t1)(cos t2), sin t2>
305 :     * This is different from wikipedia's article on spherical coordinates
306 :     * because of a phase shift, but for the generation of random numbers,
307 :     * it's irrelevant.
308 :     *)
309 :     letPRIM("cost1", IR.T_FLOAT, IR.COS, [randAngOne], fn cost1 =>
310 :     letPRIM("cost2", IR.T_FLOAT, IR.COS, [randAngTwo], fn cost2 =>
311 :     letPRIM("sint1", IR.T_FLOAT, IR.SIN, [randAngOne], fn sint1 =>
312 :     letPRIM("sint2", IR.T_FLOAT, IR.SIN, [randAngTwo], fn sint2 =>
313 :    
314 :     letPRIM("xVal", IR.T_FLOAT, IR.MULT, [cost1, cost2], fn xVal =>
315 :     letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sint1, cost2], fn yVal =>
316 :     (* zval is just sint2 *)
317 :    
318 :     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 =>
319 :     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 =>
320 :     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 =>
321 :    
322 :     letPRIM("addedVecs", IR.T_VEC, IR.ADD_VEC, [xVec, yVec], fn addedVecs =>
323 :     letPRIM("notNormVec", IR.T_VEC, IR.ADD_VEC, [addedVecs, zVec], fn nnVec =>
324 :     letPRIM("vec", IR.T_VEC, IR.NORM, [nnVec], fn vec =>
325 :    
326 :     (* Generate a random radius... *)
327 :     letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>
328 :     letPRIM("invRatio", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), ratio], fn invRatio =>
329 :     letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>
330 :     letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>
331 :     letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>
332 :     letPRIM("randValSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randValSq =>
333 :     letPRIM("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
334 :     letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>
335 :     letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>
336 :    
337 :     (* Normalize the vector and scale it by the radius. *)
338 :     letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>
339 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)
340 :     ))))))))))
341 :     ))))))))))))
342 :     ))))
343 : pavelk 746
344 :     | _ => raise Fail "Cannot generate point in specified domain."
345 :     (* end case *))
346 :     (*
347 :     | generate (Dplane{pt, n}) = Vec3f.unpack pt
348 :     | generate (Drectangle{pt, u, v}) = Vec3f.unpack pt
349 :     | generate (Dsphere{c, orad, irad}) = Vec3f.unpack c
350 :     | generate (Dblob{c, stddev}) = Vec3f.unpack c
351 :     *)
352 :    
353 :     (* This function takes an IR boolean, its environment, a particle state, domain,
354 :     * and continuation.
355 :     *
356 :     * We set the boolean to whether or not the current particle given by the particle
357 :     * state is within the domain, and then pass the continuation on.
358 :     *)
359 : pavelk 770 fun mkWithinVar (boolVar, env, var, d, stmt : IR.var -> IR.stmt) = let
360 :     val pos = var
361 : pavelk 746 in
362 :     case d
363 :     of P.D_POINT(pt) =>
364 :     letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn subVec =>
365 :     letPRIM("vecLen", IR.T_FLOAT, IR.LEN, [subVec], fn vecLen =>
366 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), vecLen], stmt)))
367 :    
368 :     (* Take the vectors going from our position to pt1, and pt2. Then
369 :     * after we normalize them, if their dot product is equal to -1, then
370 :     * they are pointing in opposite directions meaning that the position
371 :     * is inbetween pt1 and pt2 as desired.
372 :     *)
373 :     | P.D_LINE{pt1, pt2} =>
374 :     letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn posToPt1 =>
375 :     letPRIM("posToPt1Norm", IR.T_VEC, IR.NORM, [posToPt1], fn posToPt1Norm =>
376 :     letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), pos], fn posToPt2 =>
377 :     letPRIM("posToPt2Norm", IR.T_VEC, IR.NORM, [posToPt2], fn posToPt2Norm =>
378 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt2, posToPt1], fn dotProd =>
379 :     letPRIM("testMe", IR.T_FLOAT, IR.SUB, [dotProd, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn testVal =>
380 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), testVal], stmt)))))))
381 :    
382 :     (* Just see whether or not the dot product between the normal
383 :     * and the vector from a point on the plane to our position is
384 :     * greater than zero. Essentially, we're "within" a plane if we're
385 :     * behind it (with respect to the normal)
386 :     *)
387 :     | P.D_PLANE{pt, normal} =>
388 : pavelk 905 letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
389 : pavelk 746 letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
390 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))
391 :    
392 :     (* Similar to checking to see whether or not we're within a plane,
393 :     * here all we have to do is see how far we are from the center
394 :     * of the disc (pt), and then see whther or not we're perpendicular to
395 :     * the normal, and that our distance is greater than irad but less than
396 :     * orad.
397 :     *)
398 :     | P.D_DISC{pt, normal, orad, irad} =>
399 : pavelk 907 letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
400 : pavelk 746 letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
401 :     letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>
402 : pavelk 987
403 :     letPRIM("parPosToP", IR.T_VEC, IR.SCALE, [dotProd, psvToIRVar(env, normal)], fn posToPtParallelToNormal =>
404 :     letPRIM("perpPosToP", IR.T_VEC, IR.SUB_VEC, [posToPt, posToPtParallelToNormal], fn posToPtPerpToNormal =>
405 :     letPRIM("inDiscLen", IR.T_FLOAT, IR.LEN, [posToPtPerpToNormal], fn posToPtLen =>
406 :    
407 :     letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOradGt =>
408 :     letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), posToPtLen], fn inOradEq =>
409 :     letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
410 :    
411 :     letPRIM("inIradGt", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIradGt =>
412 :     letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [posToPtLen, psvToIRVar(env, irad)], fn inIradEq =>
413 :     letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
414 :    
415 : pavelk 746 letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
416 : pavelk 987
417 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))))))))
418 :    
419 : pavelk 746 (* Simply see whether or not the distance from the center is within the
420 :     * specified bounds.
421 :     *)
422 :     | P.D_SPHERE{center, orad, irad} =>
423 :     letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn posToC =>
424 :     letPRIM("posToPtLen", IR.T_VEC, IR.LEN, [posToC], fn posToCLen =>
425 :     letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>
426 :     letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>
427 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
428 : pavelk 1060
429 :     | P.D_CYLINDER {pt1, pt2, irad, orad} =>
430 :    
431 :     (* !FIXME! Right now, we see whether or not the point is within the two planes defined
432 :     * by the endpoints of the cylinder, and then testing to see whether or not the smallest
433 :     * distance to the line segment falls within the radii. It might be faster to find the
434 :     * closest point to the line defined by the endpoints and then see whether or not the point
435 :     * is within the segment.
436 :     *)
437 :    
438 :     (* Is it in one plane *)
439 :     letPRIM("plane1Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn plane1Norm =>
440 :     letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt1)], fn posToPt1 =>
441 :     letPRIM("dot1", IR.T_FLOAT, IR.DOT, [posToPt1, plane1Norm], fn dot1Prod =>
442 :     letPRIM("inPlane1", IR.T_BOOL, IR.GT, [dot1Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane1=>
443 :    
444 :     (* Is it in another plane *)
445 :     letPRIM("plane2Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), psvToIRVar(env, pt2)], fn plane2Norm =>
446 :     letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt2)], fn posToPt2 =>
447 :     letPRIM("dot2", IR.T_FLOAT, IR.DOT, [posToPt2, plane2Norm], fn dot2Prod =>
448 :     letPRIM("inPlane2", IR.T_BOOL, IR.GT, [dot2Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane2=>
449 :    
450 :     (* Is it in both planes? *)
451 :     letPRIM("inPlanes", IR.T_BOOL, IR.AND, [inPlane1, inPlane2], fn inPlanes =>
452 :    
453 :     (* Find distance from segment *)
454 :     letPRIM("a", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn a =>
455 :     letPRIM("b", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn b =>
456 :     letPRIM("alen", IR.T_FLOAT, IR.LEN, [a], fn alen =>
457 :     letPRIM("axb", IR.T_VEC, IR.CROSS, [a, b], fn axb =>
458 :     letPRIM("axblen", IR.T_FLOAT, IR.LEN, [axb], fn axblen =>
459 :     letPRIM("dist", IR.T_FLOAT, IR.DIV, [axblen, alen], fn dist =>
460 :    
461 :     (* Is distance in both radii? *)
462 :     letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), dist], fn inOradGt =>
463 :     letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), dist], fn inOradEq =>
464 :     letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
465 :    
466 :     letPRIM("inIradGt", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, irad)], fn inIradGt =>
467 :     letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [dist, psvToIRVar(env, irad)], fn inIradEq =>
468 :     letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
469 :    
470 :     letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
471 :    
472 :     (* It's in the cylinder (tube) if it's within both radii and in both planes... *)
473 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inPlanes, inBothRad], stmt)
474 :     ))))))))))))))))))))))
475 : pavelk 746 (*
476 :     | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}
477 :     | P.D_PLANE {pt: vec3f var, normal: vec3f var}
478 :     | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}
479 :     | P.D_BOX {min: vec3f var, max: vec3f var}
480 :     | P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}
481 :     | P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
482 :     | P.D_BLOB {center: vec3f var, stddev: float var}
483 :     | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}
484 :     *)
485 :     | _ => raise Fail "Cannot determine within-ness for specified domain."
486 :     (* end case *)
487 :     end (*end let *)
488 :    
489 :    
490 :     (* generate code to produce a random particle state from a domain *)
491 : pavelk 1074 fun newParticle (posDomain, (szDom : Float.float P.domain, szDist), velDomain, colDomain, env, k : particle_state -> IR.stmt) =
492 : pavelk 746 (* genVecVar (vecVar, env, domain, stmt) *)
493 :     genVecVar("ps_pos", env, posDomain, fn newPos =>
494 :     genVecVar("ps_vel", env, velDomain, fn newVel =>
495 :     genVecVar("ps_col", env, colDomain, fn newCol =>
496 : pavelk 1074 genFloatVar("ps_size", env, szDom, szDist, fn newSize =>
497 : pavelk 915 letSPRIM ("ps_ttl", IR.T_FLOAT, IR.COPY, [IR.newConst("fbool", IR.C_FLOAT 10000.0)], fn newIsDead =>
498 : pavelk 873 k(PS{pos = newPos,
499 :     vel = newVel,
500 :     size = newSize,
501 : pavelk 915 ttl = newIsDead,
502 : pavelk 900 color = newCol,
503 : pavelk 1091 user = []})
504 : pavelk 1074 )))))
505 : pavelk 746
506 :     (* Find the normal at the given position of the particle for the specified
507 :     * domain. Note, that the particle doesn't necessarily need to be on the
508 :     * domain, but if it's not then the behavior is undefined.
509 :     *)
510 :     fun normAtPoint(retNorm, d, env, state, k : IR.var -> particle_state -> IR.stmt) = let
511 :     val newNorm = IR.newParam("n", IR.T_VEC)
512 : pavelk 1091 val nextBlk = newBlockWithArgs(env, userVarsFromState(state), [newNorm], k(newNorm))
513 : pavelk 770 val PS{pos, ...} = state
514 : pavelk 746 in
515 :     (case d
516 :     of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
517 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
518 :     | P.D_DISC{pt, normal, irad, orad} =>
519 : pavelk 770 mkWithinVar("inP", env, pos, d, fn inPlane =>
520 : pavelk 746 IR.mkIF(inPlane,
521 :     (* then *)
522 :     letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
523 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk)),
524 :     (* else *)
525 :     letPRIM(retNorm,
526 :     IR.T_VEC,
527 :     IR.SCALE,
528 :     [IR.newConst("negOne", IR.C_FLOAT ~1.0), psvToIRVar(env, normal)],
529 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
530 :     )
531 :     )
532 :    
533 :     | P.D_SPHERE{center, irad, orad} => let
534 : pavelk 870 val PS{pos, ...} = state
535 : pavelk 746 in
536 :     letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>
537 :     letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar => k newNormVar state
538 :     ))
539 :     end
540 :    
541 :     | _ => raise Fail("Cannot find normal to point of specified domain.")
542 :     (* end case *))
543 :     end
544 : pavelk 769
545 : pavelk 770 fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
546 : pavelk 866
547 : pavelk 1091 val PS{ttl, user, ...} = state
548 : pavelk 1074 val P.EMIT{range, szDomain, posDomain, velDomain, colDomain, ...} = emit
549 :     val (rDom, rDist) = range
550 : pavelk 1091 val blk = newBlock (env, user, k)
551 : pavelk 770 in
552 : pavelk 918 letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
553 : pavelk 770 IR.mkIF(isDead,
554 :     (* then *)
555 : pavelk 1074 genFloatVar("t1", env, rDom, rDist, fn t1 =>
556 : pavelk 903 letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, PSV.numDead)], fn t2 =>
557 : pavelk 770 letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
558 :     letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
559 :     letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
560 :     IR.mkIF(t3,
561 :     (* then *)
562 : pavelk 1074 newParticle (posDomain, szDomain, velDomain, colDomain, env,
563 : pavelk 866 fn state' => retState state'),
564 : pavelk 770 (* else *)
565 :     IR.DISCARD)))))),
566 :     (* else *)
567 : pavelk 915 retState state))
568 : pavelk 770 end
569 :    
570 : pavelk 769 fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
571 : pavelk 870 val PS{pos, vel, ...} = state
572 : pavelk 769 val P.PR{ifstmt, ...} = pred
573 :     in
574 :     case ifstmt
575 : pavelk 770 of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>
576 : pavelk 867 IR.mkIF(withinVar, thenk(state), elsek(state)))
577 : pavelk 770 | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
578 : pavelk 867 IR.mkIF(withinVar, thenk(state), elsek(state)))
579 : pavelk 769 end
580 :    
581 : pavelk 746 fun trAct (action, env, state, k : particle_state -> IR.stmt) = let
582 : pavelk 1091 val PS{pos, vel, size, ttl, color, user} = state
583 : pavelk 746 in
584 :     case action
585 :     of P.BOUNCE{friction, resilience, cutoff, d} => let
586 : pavelk 1091 val blk = newBlock (env, user, k)
587 : pavelk 746 val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
588 :     in
589 : pavelk 903 letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn velScale =>
590 : pavelk 746 letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
591 : pavelk 987 mkWithinVar("wcp", env, pos, d, fn withinCurPos =>
592 :     mkWithinVar("wnp", env, nextPos, d, fn withinNextPos =>
593 :     letPRIM("nwcp", IR.T_BOOL, IR.NOT, [withinCurPos], fn notWithinCurPos =>
594 :     letPRIM("sb", IR.T_BOOL, IR.AND, [notWithinCurPos, withinNextPos], fn shouldBounce =>
595 :     IR.mkIF(shouldBounce,
596 : pavelk 746 (*then*)
597 :     normAtPoint("n", d, env, state, fn normAtD => fn state' => let
598 : pavelk 1091 val PS{pos=nextPos, vel=nextVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser} = state'
599 : pavelk 746 in
600 :     letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>
601 :     letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>
602 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>
603 :     letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>
604 :    
605 :     letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>
606 :     letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>
607 :     letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>
608 :    
609 :     letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>
610 :    
611 :     IR.mkIF(inCutoff,
612 :     (*then*)
613 :     letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>
614 :     letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
615 :     letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
616 :     letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
617 : pavelk 1091 goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
618 : pavelk 746 )))),
619 :     (*else*)
620 :     letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
621 : pavelk 902 letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
622 : pavelk 1091 goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
623 : pavelk 746 ))
624 :     )))))))))
625 :     end
626 :     ),
627 :     (*else*)
628 : pavelk 987 goto(state, blk))))))))
629 : pavelk 746 end
630 :    
631 : jhr 974 | P.ACCEL dir =>
632 : pavelk 903 letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>
633 : pavelk 902 letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
634 : pavelk 1091 k(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user = user})))
635 : pavelk 746
636 :     | P.MOVE =>
637 : pavelk 903 letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>
638 : pavelk 902 letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
639 : pavelk 1091 k(PS{pos = newPos, vel = vel, size = size, ttl = ttl, color = color, user = user})))
640 :    
641 : pavelk 1074 | P.ORBITPOINT {center, mag, maxRad} => let
642 : pavelk 1091 val blk = newBlock (env, user, k)
643 : pavelk 1074 in
644 :     letPRIM("toCenter", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn toCenter =>
645 :     letPRIM("dist", IR.T_FLOAT, IR.LEN, [toCenter], fn dist =>
646 :     letPRIM("radInDist", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, maxRad)], fn radInDist =>
647 :     IR.mkIF(radInDist,
648 :     (* then *)
649 :     goto(state, blk),
650 :     (* else *)
651 :     letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [dist, psvToIRVar(env, maxRad)], fn magRatio =>
652 :     letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
653 :     letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
654 :     letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
655 :     letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, toCenter], fn acc =>
656 :     letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
657 : pavelk 1091 goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)
658 : pavelk 1074 ))))))))))
659 :     end
660 :    
661 : pavelk 746
662 :     | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
663 : pavelk 1091 val blk = newBlock (env, user, k)
664 : pavelk 746 in
665 :     letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>
666 :     letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>
667 :     letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>
668 :     letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>
669 :     letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>
670 :     letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>
671 :     letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>
672 :     letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>
673 :     letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>
674 :     letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>
675 :     IR.mkIF(radInDist,
676 :     (*then*)
677 :     goto(state, blk),
678 :     (*else*)
679 :     letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>
680 :     letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
681 :     letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
682 : pavelk 903 letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
683 : pavelk 746 letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>
684 :     letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>
685 : pavelk 902 letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
686 : pavelk 1091 goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)
687 : pavelk 746 )))))))
688 :     )))))))))))
689 :     end
690 : pavelk 770
691 :     (* just kill it. *)
692 : pavelk 915 (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, ttl = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)
693 : pavelk 870 | P.DIE => IR.DISCARD
694 : pavelk 746 | _ => raise Fail("Action not implemented...")
695 :     (* end case *)
696 :     end
697 :    
698 : pavelk 868 fun compile (P.PG{
699 : pavelk 1017 emit as P.EMIT{vars=emitVars, ...},
700 : pavelk 868 act as P.PSAE{action=root_act, vars=actionVars},
701 :     render
702 :     }) = let
703 : pavelk 746 val blks = ref[]
704 :     val env = let
705 :     (* add special globals to free vars *)
706 : pavelk 1017 val vars = PSV.Set.union(emitVars, PSV.Set.addList(actionVars, [PSV.numDead, PSV.timeStep, epsilon]))
707 : pavelk 770 fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let
708 : pavelk 746 val x' = (case (ty, !binding)
709 :     of (PSV.T_BOOL, PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
710 :     | (PSV.T_BOOL, PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
711 :     | (PSV.T_INT, PSV.UNDEF) => IR.newGlobal(x, IR.T_INT)
712 :     | (PSV.T_INT, PSV.INT intVal) => IR.newConst(name, IR.C_INT(intVal))
713 :     | (PSV.T_FLOAT, PSV.UNDEF) => IR.newGlobal(x, IR.T_FLOAT)
714 :     | (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))
715 :     | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
716 :     | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
717 : pavelk 972 | _ => raise Fail("Error in setup, type mismatch between PSV vars and their binding.")
718 : pavelk 746 (* end case *))
719 :     in
720 :     PSV.Map.insert (map, x, x')
721 :     end
722 :     in
723 :     TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)
724 :     end
725 : pavelk 867
726 : pavelk 905 fun evalActs f [] state = f [] state
727 : pavelk 867 | evalActs f (psa :: psal) state = (case psa
728 :     of P.SEQ(acts) => (case acts
729 :     of [] => raise Fail "Should never reach here."
730 :     | [act] => trAct(act, env, state, evalActs f psal)
731 :     | act :: rest => trAct(act, env, state, evalActs f (P.SEQ(rest) :: psal))
732 :     (* end case *))
733 :     | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) => let
734 : pavelk 1091 val cblk = newBlock(env, userVarsFromState(state), evalActs f psal)
735 :     fun trPredActs [] state' = goto(state', cblk)
736 :     | trPredActs _ _ = raise Fail "Should never reach here."
737 :     in
738 : pavelk 867 trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)
739 : pavelk 1091 end
740 : pavelk 867 (* end case *))
741 :    
742 : pavelk 868 (* At the highest level, we want to return when we reach the end of the action list *)
743 : pavelk 746 fun trActs [] state = let
744 : pavelk 1091 val PS{pos, vel, size, ttl, color, user} = state
745 : pavelk 746 in
746 : pavelk 905 IR.mkRETURN (
747 : pavelk 1091 [ pos, vel, size, ttl, color ] @ user,
748 :     [IR.POS, IR.VEL, IR.SZ, IR.TTL, IR.COLOR ] @ (constructUserDefs(user))
749 : pavelk 905 )
750 : pavelk 1091 end
751 :     | trActs _ _ = raise Fail "Should never reach here"
752 : pavelk 868
753 :     (* The entry block is the first block of the program, or in other words, the emitter. *)
754 :     val entryBlock = newBlock (
755 : pavelk 1091 env,
756 :     userVarsFromEmit(emit),
757 : pavelk 868 fn pstate => trEmitter(
758 :     emit,
759 :     env,
760 :     pstate,
761 :     fn state => evalActs trActs root_act state
762 :     )
763 :     )
764 :    
765 : pavelk 972 (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
766 :    
767 :     fun isGlobal(IR.V{scope, ...}) = (case scope
768 :     of IR.S_GLOBAL(v) => true
769 :     | _ => false
770 :     (* end case *))
771 :    
772 :     fun extractVarMap(TE(blks, map)) = map
773 :    
774 : pavelk 866 val outPgm = PSysIR.PGM {
775 : pavelk 972 globals = PSV.Map.filter isGlobal (extractVarMap env),
776 :     emitter = entryBlock,
777 : pavelk 906 physics = List.nth(!blks, 1),
778 : pavelk 866 render = render
779 :     }
780 : pavelk 868
781 : pavelk 906 val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
782 : pavelk 868
783 : pavelk 746 in
784 : pavelk 905 (* IR.outputPgm(TextIO.stdErr, outPgm); *)
785 : pavelk 868 if Checker.checkIR(optimized) then
786 :     printErr "Compilation succeeded." (* Note: it only succeeds if we can optimize, too *)
787 : pavelk 746 else
788 : pavelk 866 ();
789 : pavelk 868 optimized
790 : pavelk 746 end (* compile *)
791 :    
792 :     end (* Translate *)

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