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

SCM Repository

[sml3d] View of /trunk/sml3d/src/particles/particles.sml
ViewVC logotype

View of /trunk/sml3d/src/particles/particles.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1160 - (download) (annotate)
Sun May 22 21:55:20 2011 UTC (8 years, 4 months ago) by pavelk
File size: 28536 byte(s)
* Added a new primitive: ACOS. It's the arc cosine function.
* Fixed a bug where in generating points in a disc, if the vector to the center of the disc was parallel to the normal, the points would only be generated at the center.
* Added implementations for generating vectors within the remaining domains. Generating a vector within a plane results in an error due to the domain being unbounded.
* Removed the "blob" domain as it has no use outside of generating points, but this effect can be simulated by providing different random distributions to the generation routine. (Not implemented yet)
* Updated the README to reflect changes.

(* particles.sml
 *
 * COPYRIGHT (c) 2011 John Reppy (http://www.cs.uchicago.edu/~jhr)
 * All rights reserved.
 *)
 
structure ParticlesImp =
  struct

    structure OP = OldParticles
    structure PSV = PSVar
    structure IR = PSysIR
    structure VSet = PSV.Set
    structure SVSet = PSV.SVSet
    structure DB = DataBuffer
    
    type float = GL.float
    type vec3f = Vec3f.vec3
    type color4f = SML3dTypes.color4f
    type color3f = SML3dTypes.color3f
    
    fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")

    (***** DOMAINS *****)
	
    type 'a var = 'a PSV.var
    type 'a state_var = 'a PSV.state_var
    datatype variable = V of string
    
    val sv_pos = PSV.newSV("pos", PSV.vec3fTy)
    val sv_vel = PSV.newSV("vel", PSV.vec3fTy)
    val sv_ttl = PSV.newSV("ttl", PSV.floatTy)
    
    datatype domain_rep
      = D_POINT of PSV.var_rep
      | D_LINE of {pt1: PSV.var_rep, pt2: PSV.var_rep}
      | D_TRIANGLE of {pt1: PSV.var_rep, pt2: PSV.var_rep, pt3: PSV.var_rep}
      | D_PLANE of {pt: PSV.var_rep, normal: PSV.var_rep}
      | D_RECT of {pt: PSV.var_rep, htvec: PSV.var_rep, wdvec: PSV.var_rep}
      | D_BOX of {min: PSV.var_rep, max: PSV.var_rep}    
      | D_SPHERE of {center: PSV.var_rep, irad: PSV.var_rep, orad: PSV.var_rep}
      | D_CYLINDER of {pt1: PSV.var_rep, pt2: PSV.var_rep, irad: PSV.var_rep, orad: PSV.var_rep}
      | D_CONE of {pt1: PSV.var_rep, pt2: PSV.var_rep, irad: PSV.var_rep, orad: PSV.var_rep}
      | D_DISC of {pt: PSV.var_rep, normal: PSV.var_rep, irad: PSV.var_rep, orad: PSV.var_rep}
    type 'a domain = domain_rep
    
    fun dToStr(D_POINT _) = "D_POINT"
      | dToStr(D_LINE _) = "D_LINE"
      | dToStr(D_TRIANGLE _) = "D_TRIANGLE"
      | dToStr(D_PLANE _) = "D_PLANE"
      | dToStr(D_RECT _) = "D_RECT"
      | dToStr(D_BOX _) = "D_BOX"    
      | dToStr(D_SPHERE _) = "D_SPHERE"
      | dToStr(D_CYLINDER _) = "D_CYLINDER"
      | dToStr(D_CONE _) = "D_CONE"
      | dToStr(D_DISC _) = "D_DISC"
        
    datatype distribution_rep
      = DIST_NORMAL of {mu : float var, sigma : float var}
      | DIST_DEC_LIN
      | DIST_INC_LIN
      | DIST_UNIFORM
      | DIST_TEXTURED of Texture.texture_id
    type 'a distribution = distribution_rep
      
    (* This is polymorphic only to enforce type safety to the user, but otherwise,
     * underneath the hood we have to make it ambiguous to avoid bloating
     * the code *)
    datatype expression
      = CONSTF of float
      | CONST3F of vec3f
      | VAR of PSV.var_rep
      | STATE_VAR of PSV.state_var_rep
      | GENERATE3F of vec3f domain * vec3f distribution
      | GENERATEF of float domain * float distribution
      | ADD of expression * expression
      | SCALE of expression * expression
      | DIV of expression * expression
      | NEG of expression
      | DOT of expression * expression
      | CROSS of expression * expression
      | NORMALIZE of expression
      
      | LENGTH of expression
      
      | INTERSECT of intersection_query 
      | NORMALTO of expression * domain_rep
            
    and condition
      = WITHINF of float domain * expression
      | WITHIN3F of vec3f domain * expression
      | DO_INTERSECT of intersection_query
      | GTHAN of expression * expression (* Is the first greater than the second *)
      
      (* General boolean expressions *)
      | AND of condition * condition
      | OR of condition * condition
      | XOR of condition * condition
      | NOT of condition      
    withtype 'a ty = 'a -> expression     
    and intersection_query = {p1 : expression, p2 : expression, d : vec3f domain}
    
    type 'a expr = expression
    
    val varToExp = VAR
    val stateVarToExp = STATE_VAR
    
    val floatTy : float ty = CONSTF
    val vec3fTy : vec3f ty = CONST3F

    fun const (theTy, theVal) = theTy theVal
        
    fun generatef(d) = GENERATEF(d, DIST_UNIFORM)
    fun generate3f(d) = GENERATE3F(d, DIST_UNIFORM)
    fun generateWithDistf(dom, dist) = GENERATEF(dom, dist)
    fun generateWithDist3f(dom, dist) = GENERATE3F(dom, dist)
	
    fun add(e1, e2) = ADD(e1, e2)
    fun scale(fex, vex) = SCALE(fex, vex)
    fun neg(e) = NEG(e)
    fun dot(e1, e2) = DOT(e1, e2)
    fun cross(e1, e2) = CROSS(e1, e2)
    fun mult(e1, e2) = SCALE(e1, e2)
    fun divide(e1, e2) = DIV(e1, e2)
    fun length(v) = LENGTH(v)
    fun normalize(v) = NORMALIZE(v) 
    
    fun adds(v1, v2, f) = add(v1, scale(f, v2)) 
    fun sub(v1, v2) = add(v1, neg(v2))
    
    fun getNormal(v, d) = NORMALTO(v, d)
       
  (* A blank action, this does nothing. *)
    val nop = CONSTF(0.0)
    
  (* Conditions... *)
    fun testWithinf({arg, d}) = WITHINF(d, arg)
    fun testWithin3f({arg, d}) = WITHIN3F(d, arg)
    fun testGreater({arg, test}) = GTHAN(arg, test)
    
    (* Common boolean expressions *)
    fun testAnd(c1, c2) = AND(c1, c2)
    fun testOr(c1, c2) = OR(c1, c2)
    fun testXOr(c1, c2) = XOR(c1, c2)
    fun testNot(c) = NOT(c)
    
    fun intersect q = { c = DO_INTERSECT q, pt = INTERSECT q }
    
  (* get the free variables of a domain *)
    fun fvsOfDomain (D_POINT x) = VSet.singleton x
      | fvsOfDomain (D_LINE{pt1, pt2}) = VSet.fromList([pt1, pt2])
      | fvsOfDomain (D_TRIANGLE{pt1, pt2, pt3}) = VSet.fromList([pt1, pt2, pt3])
      | fvsOfDomain (D_PLANE{pt, normal}) = VSet.fromList([pt, normal])
      | fvsOfDomain (D_RECT{pt, htvec, wdvec}) = VSet.fromList([pt, htvec, wdvec])
      | fvsOfDomain (D_BOX{min, max}) = VSet.fromList([min, max])
      | fvsOfDomain (D_SPHERE{center, irad, orad}) = VSet.fromList([center, irad, orad])
      | fvsOfDomain (D_CYLINDER{pt1, pt2, irad, orad}) = VSet.fromList([pt1, pt2, irad, orad])
      | fvsOfDomain (D_CONE{pt1, pt2, irad, orad}) = VSet.fromList([pt1, pt2, irad, orad])
      | fvsOfDomain (D_DISC{pt, normal, irad, orad}) = VSet.fromList([pt, normal, irad, orad])
      
    fun fvsOfDistribution(DIST_NORMAL {mu, sigma}) = VSet.fromList [mu, sigma]
      | fvsOfDistribution(DIST_DEC_LIN) = VSet.empty
      | fvsOfDistribution(DIST_INC_LIN) = VSet.empty
      | fvsOfDistribution(DIST_UNIFORM) = VSet.empty
      | fvsOfDistribution(DIST_TEXTURED _) = VSet.empty

  (***** ACTIONS *****)

    datatype action 
      = SEQ of action list
      | PRED of condition * action * action
      | ASSIGN of PSV.state_var_rep * expression
      | DIE
      
    fun branch {c, thenAct, elseAct } = PRED(c, thenAct, elseAct)
    
    fun letVar { name, ty, actFn } = let
      val newSV = PSV.newSV(name, ty)
     in 
      actFn newSV
     end
     
    val assign = ASSIGN
    
    fun letExpr { name, ty, exp, actFn } = let
      val newSV = PSV.newSV(name, ty)
     in
      SEQ [
          ASSIGN(newSV, exp),
          actFn newSV
      ]
     end
     
    (* The particle just dies (is considered invalid) *)
    val die = DIE

    val sequence = SEQ

    val nop = SEQ []
      
    (* Particles are tested to see whether they will pass from being outside the specified domain to
     * being inside it within look_ahead time units from now if the next Move() action were to occur 
     * now. The specific direction and amount of turn is dependent on the kind of domain being 
     * avoided.
     *
     * !FIXME! Implement me!
     *)
    fun avoid {
	  magnitude : float PSV.var, epsilon : float PSV.var,
	  lookAhead : float PSV.var, d : domain_rep
	} = nop;
	
    (* Particles are tested to see whether they will pass from being outside the specified vec3f domain to
     * being inside it if the next Move() action were to occur now. If they would pass through the 
     * surface of the vec3f domain, they are instead bounced off it. That is, their velocity vector is
     * decomposed into components normal to the surface and tangent to the surface. The direction of
     * the normal component is reversed, and friction, resilience and cutoff are applied to the 
     * components. They are then recomposed into a new velocity heading away from the surface.
     *)
     
    fun bounceVar ({
	  friction : float PSV.var, resilience : float PSV.var,
	  cutoff : float PSV.var, d : domain_rep
	}, {v, dv}) =
	  letExpr {
	    name = "endPt", 
	    ty = PSV.vec3fTy, 
	    exp = adds(stateVarToExp v, stateVarToExp dv, varToExp PSV.timeStep), 
	    actFn = fn endPtSV => 
	  let
	    val {c = intQuery, pt = intPt} = intersect { p1 = stateVarToExp v, p2 = stateVarToExp endPtSV, d = d }
	   in
	    letExpr {
	      name = "intPt",
	      ty = PSV.vec3fTy, 
	      exp = intPt, 
	      actFn = fn intPtSV =>
	    letExpr {
	      name = "norm", 
	      ty = PSV.vec3fTy, 
	      exp = getNormal((stateVarToExp intPtSV), d), 
	      actFn = fn normSV =>
	    letExpr {
	      name = "refPara", 
	      ty = PSV.vec3fTy, 
	      exp = scale(dot(stateVarToExp dv, stateVarToExp normSV), stateVarToExp normSV), 
	      actFn = fn refParaSV =>
	    letExpr {
	      name = "refVec", 
	      ty = PSV.vec3fTy, 
	      exp = add(
	        scale(varToExp resilience, neg(stateVarToExp refParaSV)), 
	        scale(varToExp friction, sub(stateVarToExp dv, stateVarToExp refParaSV))
	      ),
	      actFn = fn refVecSV =>
	        branch {
	        c = intQuery,
	        thenAct = SEQ[
	          branch {
	            c = testGreater {arg = length(stateVarToExp refVecSV), test = varToExp cutoff},
	            thenAct = assign(dv, scale(varToExp cutoff, normalize(stateVarToExp refVecSV))),
	            elseAct = assign(dv, stateVarToExp refVecSV)
	          },
	          ASSIGN(
	            v, 
	            adds(
	              stateVarToExp intPtSV, 
	              stateVarToExp dv, 
	              mult(
	                divide(
	                  length (sub (stateVarToExp intPtSV, stateVarToExp endPtSV)),
	                  length (sub (stateVarToExp v, stateVarToExp endPtSV))
	        	    ), 
	        	    varToExp PSV.timeStep
	        	  )
	            )
	          ) 
	        ],
	        elseAct = nop
	        } (* branch *)
	    } (* refVec *)
	    } (* refPerp *)
	    } (* norm *)
	    } (* intPt *)
	  end } (* endPt *)
	
	fun bounce(x) = bounceVar (x, {v = sv_pos, dv = sv_vel})
	
    (* If a particle's velocity magnitude is within vlow and vhigh, then multiply each component of
     * the velocity by the respective damping constant. *)
    fun dampingVar ({coeff, vlow, vhi}, v) = let
      val mag = length (stateVarToExp v)
      val tooBig = testGreater {arg = mag, test = varToExp vhi}
      val tooSmall = testGreater {arg = varToExp vlow, test = mag }
      val within = testAnd(tooBig, tooSmall)
     in
      branch {
        c = within,
        thenAct = assign(v, scale(varToExp coeff, stateVarToExp v)),
        elseAct = nop
      }
     end
     
    fun damping x = dampingVar (x, sv_vel)
	  
    (* Causes an explosion by accelerating all particles away from the center. Particles are 
     * accelerated away from the center by an amount proportional to magnitude. The shock wave of 
     * the explosion has a gaussian magnitude. The peak of the wave front travels spherically 
     * outward from the center at the specified velocity. So at a given time step, particles at a 
     * distance (velocity * age) from center will receive the most acceleration, and particles not
     * at the peak of the shock wave will receive a lesser outward acceleration.
     *)
    fun explosion {
	    center : vec3f PSV.var, velocity : float PSV.var, magnitude : float PSV.var,
	    stdev : float PSV.var, epsilon : float PSV.var, age : float PSV.var
	  } = nop
      
    (* The scaled acceleration vector is simply added to the velocity vector of each particle at 
     * each time step.
     *)
    fun accelerate a = assign(sv_vel, adds(stateVarToExp sv_vel, varToExp a, varToExp PSV.timeStep))
    fun gravity mag = assign(sv_vel, adds(stateVarToExp sv_vel, scale(varToExp mag, CONST3F {x=0.0, y= ~1.0, z=0.0}), varToExp PSV.timeStep))
    
    (*  Removes all particles older than age_limit. But if kill_less_than is true, it instead 
     * removes all particles newer than age_limit. age_limit is not clamped, so negative values are
     * ok. This can be used in conjunction with StartingAge(-n) to create and then kill a particular 
     * set of particles.
     *)	 
    fun killOld {age : float PSV.var, kill_less_than : bool} = let
      val older = testGreater {arg = stateVarToExp sv_ttl, test = varToExp age}
      val younger = testGreater {arg = varToExp age, test = stateVarToExp sv_ttl} 
     in
      if kill_less_than then
        branch {
          c = younger,
          thenAct = DIE,
          elseAct = nop
        }
      else
        branch {
          c = older,
          thenAct = DIE,
          elseAct = nop
        }
    end
 
    (* This action actually updates the particle positions by adding the current velocity to the 
     * current position and the current rotational velocity to the current up vector. This is 
     * typically the last particle action performed in an iteration of a particle simulation, and 
     * typically only occurs once per iteration. *)     
    val move = 
      assign(sv_pos, 
        adds(
          stateVarToExp sv_pos, 
          stateVarToExp sv_vel, 
          varToExp PSV.timeStep
        )
      )
    
    (* For each particle, this action computes the vector to the center point, and accelerates the 
     * particle in the vector direction. *)
	fun orbitVarAboutPoint ({center : vec3f PSV.var, mag : float PSV.var, maxRad : float PSV.var}, {v, dv})
	  = letExpr {
	      name = "diffVec",
	      ty = PSV.vec3fTy, 
	      exp = sub(varToExp center, stateVarToExp v), 
	      actFn = fn diffVecSV =>
	    branch {
	      c = testGreater {arg = varToExp maxRad, test = length(stateVarToExp diffVecSV)},
	      thenAct = assign(dv,
	        adds(
	          stateVarToExp dv,
	          stateVarToExp diffVecSV,
	          mult(varToExp mag, varToExp PSV.timeStep)
	        )
	      ),
	      elseAct = nop
	    }}
	    
    fun orbitPoint(args) = orbitVarAboutPoint(args, {v=sv_pos, dv=sv_vel})
    
    (* For each particle, this action computes the vector to the closest point on the line
     * segment and accelerates the particle in that direction. *)  
    fun orbitVarAboutLineSegment ({endp1, endp2, mag, maxRad}, {v, dv})
      = letExpr {
          name = "segVec",
          ty = PSV.vec3fTy,
          exp = sub(varToExp endp2, varToExp endp1),
          actFn = fn segVecSV =>
        letExpr {
          name = "segVecNorm",
          ty = PSV.vec3fTy,
          exp = normalize(stateVarToExp segVecSV),
          actFn = fn segVecNormSV =>
        letExpr {
          name = "ptProjDist",
          ty = PSV.floatTy,
          exp = dot(sub(stateVarToExp v, varToExp endp1), stateVarToExp segVecNormSV),
          actFn = fn ptProjDistSV =>
        letVar {
          name = "closestPt",
          ty = PSV.vec3fTy,
          actFn = fn closestPt => 
        sequence [
          branch {
            c = testGreater {arg = stateVarToExp ptProjDistSV, test = length(stateVarToExp segVecSV)},
            thenAct = assign(closestPt, varToExp endp2),
            elseAct = branch{
              c = testGreater {arg = const(floatTy, 0.0), test = stateVarToExp ptProjDistSV},
              thenAct = assign(closestPt, varToExp endp1),
              elseAct = assign(closestPt,
                adds(
                  varToExp endp1,
                  stateVarToExp segVecNormSV,
                  stateVarToExp ptProjDistSV
                )
              )
            }
          },
          (* Orbit the closest point here.... this is mostly copy pasta *)
          letExpr {
	        name = "diffVec",
	        ty = PSV.vec3fTy, 
	        exp = sub(stateVarToExp closestPt, stateVarToExp v), 
	        actFn = fn diffVecSV =>
	      branch {
	        c = testGreater {arg = varToExp maxRad, test = length(stateVarToExp diffVecSV)},
	        thenAct = assign(dv,
	          adds(
	            stateVarToExp dv,
	            stateVarToExp diffVecSV,
	            mult(varToExp mag, varToExp PSV.timeStep)
	          )
	        ),
	        elseAct = nop
	      }}
	    ] (* sequence *)
        } (* ptProjDist *)
        } (* closestPt *)
        } (* segVecNorm *)
        } (* segVec *)
        
    fun orbitLineSegment(args) = orbitVarAboutLineSegment(args, {v = sv_pos, dv = sv_vel})

    (* For each particle, chooses an acceleration vector from the specified vec3f domain and adds it to 
     * the particle's velocity. Reducing the time step, dt, will make a higher probability of being 
     * near the original velocity after unit time. Smaller dt approach a normal distribution of 
     * velocity vectors instead of a square wave distribution.
     *)  
	fun randomAccel d = 
	  assign(sv_vel,
	    adds(
	      stateVarToExp sv_vel,
	      generate3f d,
	      varToExp PSV.timeStep
	    )
	  )
	

    (* Chooses a displacement vector from the specified vec3f domain and adds it to the particle's 
     * position. Reducing the time step, dt, will make a higher probability of being near the 
     * original position after unit time. Smaller dt approach a normal distribution of particle
     * positions instead of a square wave distribution.
     *)
    fun randomDisplace d = 
	  assign(sv_pos,
	    adds(
	      stateVarToExp sv_pos,
	      generate3f d,
	      varToExp PSV.timeStep
	    )
	  )

    (* For each particle, sets the particle's velocity vector to a random vector in the specified
     * vec3f domain. This function is not affected by dt.
     *)
    fun randomVelocity d = assign( sv_vel, generate3f d )


  (* Computes each particle’s speed (the magnitude of its velocity vector) and if it is less than 
   * min_speed or greater than max_speed the velocity is scaled to within those bounds, while 
   * preserving the velocity vector’s direction.
   *)     
    fun limit ({min : float PSV.var, max : float PSV.var}, v) = let
      val mag = length (stateVarToExp v)
      val bigger = testGreater {arg = mag, test = varToExp max}
      val smaller = testGreater {arg = varToExp min, test = mag}
     in
      branch {
        c = bigger,
        thenAct = assign(v, varToExp max),
        elseAct = branch {
          c = smaller,
          thenAct = assign(v, varToExp min),
          elseAct = nop
        }
      }
     end
      
    fun speedLimit r = limit (r, sv_vel)

  (* Move a target state variable towards a target. The variable moves towards its
   * target at a speed of scale/sec *)     
    fun targetVec {var, target, scale}
      = letExpr {
          name = "diffVec",
	      ty = PSV.vec3fTy, 
	      exp = sub(varToExp target, stateVarToExp var), 
	      actFn = fn diffVecSV =>
	    branch {
	      c = testGreater{ arg = mult(varToExp scale, varToExp PSV.timeStep), test = length(stateVarToExp diffVecSV)},
	      thenAct = assign(var, varToExp target),
	      elseAct = 
	        assign(var, 
	          adds(
	            stateVarToExp var, 
	            normalize(stateVarToExp diffVecSV), 
	            mult(varToExp scale, varToExp PSV.timeStep)
	          )
	        )
	    }}
	   

  (* Move a target state variable towards a target. The variable moves towards its
   * target at a speed of scale/sec 
   * !SPEED! @PK: This seems longer than it should be... *)
    fun targetFloat {var, target, scale}
      = letExpr {
          name = "diff",
	      ty = PSV.floatTy, 
	      exp = sub(varToExp target, stateVarToExp var), 
	      actFn = fn diffSV =>
	    branch {
	      c = testGreater{ arg = stateVarToExp diffSV, test = const(floatTy, 0.0) },
	      thenAct = 
            branch {
	          c = testGreater{ 
	            arg = mult(varToExp scale, varToExp PSV.timeStep), 
	            test = stateVarToExp diffSV
	          },
	          thenAct = assign(var, varToExp target),
	          elseAct = assign(var, 
	            add(
	              stateVarToExp var, 
	              mult(varToExp scale, varToExp PSV.timeStep)
	            )
	          )
	        },
	      elseAct =
	        branch {
	          c = testGreater{ 
	            arg = stateVarToExp diffSV, 
	            test = neg(mult(varToExp scale, varToExp PSV.timeStep))
	          },
	          thenAct = assign(var, varToExp target),
	          elseAct = assign(var, 
	            add(
	              stateVarToExp var, 
	              neg(mult(varToExp scale, varToExp PSV.timeStep))
	            )
	          )
	        }
	    }}

    fun normal_dist settings = DIST_NORMAL(settings)
    val dec_lin_dist = DIST_DEC_LIN
    val inc_lin_dist = DIST_INC_LIN
    val uniform_dist = DIST_UNIFORM
    val uniform_vec_dist = DIST_UNIFORM
    fun textured_float_dist tex = DIST_TEXTURED tex
    fun textured_vec_dist tex = DIST_TEXTURED tex
    
    val point = D_POINT
    fun line (endPt1, endPt2) = D_LINE{pt1 = endPt1, pt2 = endPt2}
    fun triangle (p1, p2, p3) = D_TRIANGLE{pt1 = p1, pt2 = p2, pt3 = p3}
    fun plane {pt, n} = D_PLANE{pt=pt, normal=n}
    fun rectangle {corner, wid, ht} = D_RECT{pt=corner, htvec=ht, wdvec=wid}
    fun box {min, max} = D_BOX{min=min, max=max}
    fun sphere {c, r} = D_SPHERE{center = c, irad = PSV.constf 0.0, orad = r}
    fun ball {c, ir, or} = D_SPHERE{center=c, irad=ir, orad=or}
    fun tube {point1, point2, irad, orad} = 
	  D_CYLINDER{pt1=point1, pt2=point2, irad=irad, orad=orad}
    fun cylinder {point1, point2, rad} = 
	  D_CYLINDER{pt1=point1, pt2=point2, irad= PSV.constf 0.0, orad = rad}
    fun cone {apex, cbase, irad, orad} = 
	  D_CONE{pt1=apex, pt2=cbase, irad=irad, orad=orad}
    fun disc {center, normal, irad, orad} = 
	  D_DISC{pt=center, normal=normal, irad=irad, orad=orad}
    fun range r = box r
    val value = point

      
    datatype generator = GEN of {
      var : PSV.state_var_rep,
      exp : expression
    }
    
    datatype emitter = EMIT of {
      freq : expression,
      sv_gens : generator list
    }
    
    fun newEmitter({range, positions, velocities, lifetimes}) = EMIT {
      freq = range,
      sv_gens = [
        GEN { var = sv_pos, exp = positions },
        GEN { var = sv_vel, exp = velocities },
        GEN { var = sv_ttl, exp = lifetimes }
      ]
    }
    
    datatype renderer = REND of {
      prim : PSysIR.renderer,
      sv_gens : generator list,
      names : string PSV.SVMap.map
    }
    
    fun points {colors as (sv, exp_color)} = REND { 
      prim = PSysIR.POINTS, 
      sv_gens = [ GEN { var = sv, exp = exp_color } ],
      names = PSV.SVMap.singleton (sv, "color")
    }
    
    fun texQuads {textureList, sizes, rotations} = let
      val sing = PSV.SVMap.singleton
      val union = PSV.SVMap.unionWith (fn x => raise Fail("Adding the same variable."))
      val (sv_sz, exp_sz) = sizes
      val (sv_rot, exp_rot) = rotations
     in
      REND {
        prim = PSysIR.TEXTURED_QUADS(textureList),
        sv_gens = [
          GEN { var = sv_sz, exp = exp_sz },
          GEN { var = sv_rot, exp = exp_rot }
        ],
        names = union (sing (sv_sz, "size"), sing (sv_rot, "rot"))
      }
     end
      
    datatype program = PG of {
	  emit: emitter, 
	  act : action,
	  render : PSysIR.renderer,
	  vars : VSet.set,
	  state_vars : SVSet.set,
	  render_vars : string PSV.SVMap.map
    }
       
    fun create {emit, act, render} = let
      fun extractVars(expr) = let
        fun evh(CONSTF f) = VSet.empty 
          | evh(CONST3F vec) = VSet.empty 
          | evh(VAR v) =  VSet.singleton v
          | evh(STATE_VAR v) = VSet.empty 
          | evh(GENERATEF (dom, dist)) = VSet.union(fvsOfDomain dom, fvsOfDistribution dist)
          | evh(GENERATE3F (dom, dist)) = VSet.union(fvsOfDomain dom, fvsOfDistribution dist)
          | evh(ADD (e1, e2)) = VSet.union(evh(e1), evh(e2)) 
          | evh(NEG ex) = evh(ex)
          | evh(SCALE (e1, e2)) = VSet.union(evh(e1), evh(e2))
          | evh(DIV (e1, e2)) = VSet.union(evh(e1), evh(e2))
          | evh(DOT (e1, e2)) = VSet.union(evh(e1), evh(e2))
          | evh(CROSS (e1, e2)) = VSet.union(evh(e1), evh(e2))
          | evh(NORMALIZE e) = evh e
          | evh(LENGTH e) = evh e
          | evh(INTERSECT ({p1, p2, d})) = VSet.union(fvsOfDomain d, VSet.union(evh(p1), evh(p2)))
          | evh(NORMALTO (e, d)) = VSet.union(fvsOfDomain d, evh e)
       in
        evh(expr)
       end (* extractVars *)
       
      fun extractStateVars(expr) = let
        fun evh(CONSTF f) = SVSet.empty 
          | evh(CONST3F vec) = SVSet.empty 
          | evh(VAR v) = SVSet.empty
          | evh(STATE_VAR v) = SVSet.singleton v
          
          (* We don't support domains based on state variables because they
           * are not uniform across the particle system. ... That being said,
           * there might be an interesting application to particle-specific 
           * domains, like small spheres defined around the particle. I'm not
           * sure what though. *)
          | evh(GENERATEF (dom, dist)) = SVSet.empty
          | evh(GENERATE3F (dom, dist)) = SVSet.empty
          
          | evh(ADD (e1, e2)) = SVSet.union(evh(e1), evh(e2)) 
          | evh(NEG ex) = evh(ex)
          | evh(SCALE (e1, e2)) = SVSet.union(evh(e1), evh(e2))
          | evh(DIV (e1, e2)) = SVSet.union(evh(e1), evh(e2))
          | evh(DOT (e1, e2)) = SVSet.union(evh(e1), evh(e2))
          | evh(CROSS (e1, e2)) = SVSet.union(evh(e1), evh(e2))
          | evh(NORMALIZE e) = evh e
          | evh(LENGTH e) = evh e
          | evh(INTERSECT ({p1, p2, d})) = SVSet.union(evh(p1), evh(p2))
          | evh(NORMALTO (e, d)) = evh e
       in
        evh(expr)
       end (* extractStateVars *)
      
      fun extractFromCond(WITHINF (d, exp), fd, evh, union) 
         = union(fd d, evh (exp))
        | extractFromCond(WITHIN3F (d, exp), fd, evh, union) 
         = union(fd d, evh (exp))
        | extractFromCond(GTHAN (f, t), fd, evh, union)
         = union(evh (f), evh (t))
        | extractFromCond(AND (c1, c2), fd, evh, union)
         = union(extractFromCond (c1, fd, evh, union), extractFromCond (c2, fd, evh, union))
        | extractFromCond(OR (c1, c2), fd, evh, union)
         = union(extractFromCond (c1, fd, evh, union), extractFromCond (c2, fd, evh, union))
        | extractFromCond(XOR (c1, c2), fd, evh, union)
         = union(extractFromCond (c1, fd, evh, union), extractFromCond (c2, fd, evh, union))
        | extractFromCond(NOT c, fd, evh, union) = extractFromCond (c, fd, evh, union)
        | extractFromCond(DO_INTERSECT ({p1, p2, d}), fd, evh, union)
         = union(fd d, union(evh p1, evh p2))
        
      fun getSVs(SEQ al) = List.foldl SVSet.union SVSet.empty (List.map getSVs al)
        | getSVs(PRED (cond, act1, act2)) = let 
           fun getCondVars(x) = extractFromCond(x, fn x => SVSet.empty, extractStateVars, SVSet.union)
          in
           SVSet.union (
             getCondVars(cond),
             SVSet.union (getSVs act1, getSVs act2)
           )
          end
        | getSVs(ASSIGN (sv, exp)) 
          = SVSet.union( SVSet.singleton sv, extractStateVars(exp) )
        | getSVs(DIE) = SVSet.empty
        
      fun getVs(SEQ al) = List.foldl VSet.union VSet.empty (List.map getVs al)
        | getVs(PRED (cond, act1, act2)) = let 
           fun getCondVars(x) = extractFromCond(x, fvsOfDomain, extractVars, VSet.union)
          in
           VSet.union (
             getCondVars(cond),
             VSet.union (getVs act1, getVs act2)
           )
          end
        | getVs(ASSIGN (sv, exp)) = extractVars(exp)
        | getVs(DIE) = VSet.empty
        
      val REND{prim, sv_gens=rend_sv_gens, names} = render
      val EMIT{freq, sv_gens} = emit
      
      val gens = sv_gens @ rend_sv_gens
      
      fun getVsFromGen(GEN{var, exp}) = extractVars(exp)
      fun getSVsFromGen(GEN{var, exp}) 
        = SVSet.union( SVSet.singleton var, extractStateVars(exp) )
        
      val union = PSV.SVMap.unionWith (fn x => raise Fail("Adding the same variable."))
      val preDefVars = [PSV.numDead, PSV.timeStep]
     in
      PG{
        emit = EMIT{ freq = freq, sv_gens = gens },
        act = act,
        render = prim,
        vars = List.foldl VSet.union VSet.empty 
          ([getVs act, extractVars(freq), VSet.fromList preDefVars] @ (List.map getVsFromGen gens)),
        state_vars = List.foldl  SVSet.union SVSet.empty 
          ([getSVs act, extractStateVars(freq)] @ (List.map getSVsFromGen gens)),
        render_vars = union (PSV.SVMap.singleton (sv_ttl, "ttl"),
          union (PSV.SVMap.singleton (sv_pos, "pos"), names))
      }
     end (* create *)

  end

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