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 1093 - (download) (annotate)
Thu Mar 17 05:23:02 2011 UTC (8 years, 6 months ago) by pavelk
File size: 18356 byte(s)
Initial test for high level particle system language
(* 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 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
    
    val sv_pos = PSV.newSV("sv_pos", PSV.vec3fTy)
    val sv_vel = PSV.newSV("sv_vel", PSV.vec3fTy)
    
    datatype 'a domain
      = D_POINT of 'a var
      | D_LINE of {pt1: 'a var, pt2: 'a var}
      | D_TRIANGLE of {pt1: 'a var, pt2: 'a var, pt3: 'a var}
      | D_PLANE of {pt: 'a var, normal: 'a var}
      | D_RECT of {pt: 'a var, htvec: 'a var, wdvec: 'a var}
      | D_BOX of {min: 'a var, max: 'a var}    
      | D_SPHERE of {center: 'a var, irad: 'a var, orad: 'a var}
      | D_CYLINDER of {pt1: 'a var, pt2: 'a var, irad: float var, orad: float var}
      | D_CONE of {pt1: 'a var, pt2: 'a var, irad: float var, orad: float var}
      | D_BLOB of {center: 'a var, stddev: float var}
      | D_DISC of {pt: 'a var, normal: 'a var, irad: float var, orad: float var}
      
      
	datatype 'a expr 
      = CONST of 'a
      | VAR of 'a var
      | STATE_VAR of 'a state_var
      | GENERATE of 'a domain
      | ADD of 'a expr * 'a expr
      | SCALE of 'a expr * 'b expr
      | NEG of 'a expr
      | TEST_WITHIN of {var : 'b expr, d : 'b domain, thenExpr : 'a expr, elseExpr : 'a expr}
      (* ... *)
      | END
      
    fun varToExp(v) = VAR v
	fun stateVarToExp(v) = STATE_VAR v
	fun const(v) = CONST v
	fun generate(d) = GENERATE d
	
	fun add(e1, e2) = ADD (e1, e2)
	fun scale(scalar, vector) = SCALE (vector, scalar)
	fun neg(exp) = NEG exp
	
	fun testWithin(exp) = TEST_WITHIN(exp)

        
  (* 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_BLOB{center, stddev}) = VSet.fromList([center, stddev])
      | fvsOfDomain (D_DISC{pt, normal, irad, orad}) = VSet.fromList([pt, normal, irad, orad])

    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 blob {center, stddev} = D_BLOB{center=center, stddev=stddev}
    fun disc {center, normal, irad, orad} = 
      D_DISC{pt=center, normal=normal, irad=irad, orad=orad}
    fun range r = box r
    val value = point


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

    datatype act
    (* 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.
     *)
      = AVOID of vec3f domain
    (* 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.
     *)
      | BOUNCE of {friction : float PSV.var, resilience : float PSV.var, cutoff : float PSV.var, d : vec3f domain} 
    (* If a particle's velocity magnitude is within vlow and vhigh, then multiply each component of
     * the velocity by the respective damping constant. Typically, the three components of damping
     * will have the same value.
     *)
      | DAMPING
    (* 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.
     *)
      | EXPLOSION
    (* This allows snaky effects where the particles follow each other. Each particle is accelerated 
     * toward the next particle in the group. The follow action does not affect the last particle in
     * the group. This allows controlled effects where the last particle in the group is killed
     * after each time step and replaced by a new particle at a slightly different position. See 
     * KillOld to learn how to kill the last particle in the group after each step.
     *)
      | FOLLOW
    (* Each particle is accelerated toward each other particle. *)
      | GRAVITATE
    (* The scaled acceleration vector is simply added to the velocity vector of each particle at 
     * each time step.
     *)
      | ACCEL of float PSV.var
    (* For each particle within the jet's vec3f domain of influence, dom, Jet chooses an acceleration 
     * vector from the vec3f domain acc and applies it to the particle's velocity.
     *)
      | JET
    (*  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.
     *)	 
      | KILLOLD
    (* Each particle is accelerated toward the weighted mean of the velocities of the other 
     * particles in the group.
     *)	      
      | MATCHVEL
    (* 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.
     *)	      
      | MOVE
    (* For each particle, this action computes the vector to the closest point on the line, and 
     * accelerates the particle in that direction.
     *)     
      | ORBITLINESEG of {endp1 : vec3f PSV.var, endp2 : vec3f PSV.var, mag : float PSV.var, maxRad : float PSV.var}
    (* For each particle, this action computes the vector to the center point, and accelerates the 
     * particle in the vector direction.
     *)
      | ORBITPOINT of {center : vec3f PSV.var, mag : float PSV.var, maxRad : float PSV.var}
    (* 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.
     *)
      | RANDOMACCEL of vec3f domain
    (* 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.
     *)
      | RANDOMDISP of vec3f domain
    (* 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.
     *)
      | RANDOMVEL of vec3f domain
  (* 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.
   *)     
      | SPEEDLIMIT
  (* Modifies the color and alpha of each particle to be scale percent of the way closer to the 
   * specified color and alpha. scale is multiplied by dt before scaling the sizes. Thus, using 
   * smaller dt causes a slightly faster approach to the target color.
   *)     
      | TARGETCOLOR
  (* Modifies the size of each particle to be scale percent of the way closer to the specified 
   * size triple. This makes sizes grow asymptotically closer to the given size. scale is 
   * multiplied by dt before scaling the sizes. Thus, using smaller dt causes a slightly faster
   * approach to the target size. The separate scales for each component allow only selected 
   * components to be scaled.
   *)
      | TARGETSIZE
  (* Modifies the velocity of each particle to be scale percent of the way closer to the specified 
   * velocity. This makes velocities grow asymptotically closer to the given velocity. scale is 
   * multiplied by dt before scaling the velocities. Thus, using smaller dt causes a slightly 
   * faster approach to the target velocity.
   *)
      | TARGETVEL
  (* The vortex is a complicated action to use, but when done correctly it makes particles fly 
   * around like in a tornado.
   *)     
      | VORTEX
      
   (* The particle just dies (is considered invalid) *)
      | DIE
      
    datatype cond 
      (* Tests whether or not the particle is within the given domain. *)
      = WITHIN of vec3f domain
      | WITHINVEL of vec3f domain
      (* ... *)
      
    datatype combinator
      = PRED of pred
      | SEQ of act list
      
    and pred = PR of {
      ifstmt : cond,
      thenstmt : combinator list,
      elsestmt : combinator list
    }          

    datatype action = PSAE of {
	action : combinator list,
	vars : VSet.set
      }
      
    val nop = PSAE{action=[], vars=VSet.empty}
      
    fun within {d : vec3f domain, thenStmt : action, elseStmt : action} = let
      val PSAE{action=elseAct, vars=elseVars} = elseStmt
      val PSAE{action=thenAct, vars=thenVars} = thenStmt
     in
      PSAE{ 
       action=[PRED(PR{ifstmt = WITHIN(d), thenstmt = thenAct, elsestmt = elseAct})],
       vars = VSet.union(VSet.union(fvsOfDomain(d), thenVars), elseVars)
      }
     end

    local
      fun mkAct (fvs, acts) = PSAE{action=[SEQ(acts)], vars=fvs}
    in
    fun avoid {
	  magnitude : float PSV.var, epsilon : float PSV.var,
	  lookAhead : float PSV.var, d : vec3f domain
	} = mkAct(VSet.addList(fvsOfDomain(d), [magnitude, epsilon, lookAhead]), [AVOID d])
    fun bounce {
	  friction : float PSV.var, resilience : float PSV.var,
	  cutoff : float PSV.var, d : vec3f domain
	} = mkAct(VSet.addList(fvsOfDomain(d), [friction, resilience, cutoff]), 
	          [BOUNCE {friction = friction, resilience = resilience, cutoff = cutoff, d  = d}]
	    )
    fun damping {coeff : vec3f PSV.var, vlow : float PSV.var, vhi : float PSV.var} =
	  mkAct(VSet.fromList([coeff, vlow, vhi]), [DAMPING])
    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
	  } = mkAct(VSet.fromList([center, velocity, magnitude, stdev, epsilon, age]), [EXPLOSION])
    fun follow {
      magnitude : float PSV.var, epsilon : float PSV.var, maxRadius : float PSV.var
    } = mkAct(VSet.fromList([magnitude, epsilon, maxRadius]), [FOLLOW])
    fun gravitate {mag : float PSV.var, epsilon : float PSV.var, maxRad : float PSV.var} 
      = mkAct(VSet.fromList([mag, epsilon, maxRad]), [GRAVITATE])
    fun accelerate a = mkAct(VSet.singleton a, [ACCEL a])
    fun jet {center : vec3f PSV.var, mag : float PSV.var, epsilon : float PSV.var, maxRad : float PSV.var}
	  = mkAct(VSet.fromList([center, mag, epsilon, maxRad]), [JET])
    fun killOld {ageLimit : float PSV.var, kill_less_than : bool PSV.var} =
    	mkAct(VSet.fromList([ageLimit, kill_less_than]), [KILLOLD])
    fun matchVelocity {mag : float PSV.var, epsilon : float PSV.var, maxRad : float PSV.var} 
        = mkAct(VSet.fromList([mag, epsilon, maxRad]), [MATCHVEL])
    val move = mkAct(VSet.empty, [MOVE])
    fun orbitLineSegment (olsAct as {endp1 : vec3f PSV.var, endp2 : vec3f PSV.var, mag : float PSV.var, maxRad : float PSV.var}) = 
	    mkAct(VSet.fromList([endp1, endp2, mag, maxRad]), [ORBITLINESEG olsAct])
    fun orbitPoint (opAct as {center : vec3f PSV.var, mag : float PSV.var, maxRad : float PSV.var})
	  = mkAct(VSet.fromList([center, mag, maxRad]), [ORBITPOINT opAct])
    fun randomAccel d = mkAct(fvsOfDomain d, [RANDOMACCEL d])
    fun randomDisplace d = mkAct(fvsOfDomain d, [RANDOMDISP d])
    fun randomVelocity d = mkAct(fvsOfDomain d, [RANDOMVEL d])
    fun speedLimit {min : float PSV.var, max : float PSV.var} 
      = mkAct(VSet.fromList([min, max]), [SPEEDLIMIT])
    fun targetColor {color : vec3f PSV.var, alpha: float PSV.var, scale : float PSV.var}
      = mkAct(VSet.fromList([color, alpha, scale]), [TARGETCOLOR])
    fun targetSize {size : vec3f PSV.var, scale : vec3f PSV.var}
      = mkAct(VSet.fromList([size, scale]), [TARGETSIZE])
    fun targetVelocity (targetVel, scale)
      = mkAct(VSet.fromList([targetVel, scale]), [TARGETVEL])
    fun vortex {
	    center : vec3f PSV.var, axis : vec3f PSV.var, mag : float PSV.var,
	    epsilon : float PSV.var, maxRad : float PSV.var
	  } = mkAct(VSet.fromList([center, axis, mag, epsilon, maxRad]), [VORTEX])
	val die = mkAct(VSet.empty, [DIE])
	  
  (* This is a generic "add an action to a current particle group" function. Currently action lists
   * need to be recreated before each update call, but eventually this will only be done in setup.
   *)
    fun catAction (PSAE{vars=fvs1, action=acts1}, PSAE{vars=fvs2, action=acts2}) =
	  PSAE{action=(acts1 @ acts2), vars=VSet.union(fvs1, fvs2)}
    end (* local *)
    
    fun sequence [] = nop
      | sequence acts = let
	  fun actBuilder [] = raise Fail "Should never reach here."
	    | actBuilder [a] = a
	    | actBuilder (a :: acs) = catAction(a, actBuilder(acs))
	  fun condense [] = []
	    | condense (a :: acs) = let 
		fun condensePred (PR{ifstmt, thenstmt, elsestmt}) = PR{
			ifstmt = ifstmt,
			thenstmt = condense thenstmt,
			elsestmt = condense elsestmt}
		in
		  case a
		   of PRED p => PRED(condensePred p) :: condense(acs)
		    | SEQ(actions) => let
			val condensed = condense(acs)
			val identity = a :: condensed
			in
			  case condensed
			   of [] => identity
			    | a1 :: rest => (case a1
				 of PRED(p) => identity
				  | SEQ(actions2) => SEQ(actions @ actions2) :: rest
				(* end case *))
			  (* end case *)
			end
		  (* end case *)
		end
	  val PSAE{action, vars} = actBuilder(acts)
	  in
	    PSAE{action = condense(action), vars = vars}
	  end

    type renderer = PSysIR.renderer
    val points = PSysIR.POINTS
    fun texQuads(img) = PSysIR.TEXTURED_QUADS(img)

    datatype 'a distribution 
      = DIST_NORMAL of {mu : float var, sigma : float var}
      | DIST_DEC_LIN
      | DIST_INC_LIN
      | DIST_UNIFORM
      | DIST_TEXTURED of Texture.texture_id
    
    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
    
    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
      
    datatype 'a generator = GEN of {
      var : 'a PSV.state_var,
      d : 'a domain,
      dist : 'a distribution
    }
      
	fun create_generator gen = GEN gen
    
    datatype emitter = EMIT of {
	range : float domain * float distribution,
	szDomain : float domain * float distribution,
	posDomain : vec3f domain, 
	velDomain : vec3f domain, 
	colDomain : vec3f domain,
	vars : VSet.set
      }
    
    fun newEmitter({range as (rDom, rDist), 
                    szRange as (szDom, szDist), 
                    posDomain, velDomain, colDomain
      }) = EMIT{
	   range = range,
	   szDomain = szRange,
	   posDomain = posDomain,
	   velDomain = velDomain,
	   colDomain = colDomain,
	   vars = 
	    VSet.union(fvsOfDomain(rDom),
	     VSet.union(fvsOfDistribution(rDist), 
	      VSet.union(fvsOfDomain(szDom),
	       VSet.union(fvsOfDistribution(szDist), 
	        VSet.union(fvsOfDomain(posDomain), 
	         VSet.union(fvsOfDomain(velDomain), fvsOfDomain(colDomain))
	    )))))
      }
    
    datatype program = PG of {
	emit: emitter, 
	act : action, 
	render : renderer
      }
    
    val create = PG

  end

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