Particle Systems Example

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  This code is based on an
;;  example written by Steve May.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define *gravity* (vec3 0 -0.98 0))
(define *damping* 1)
(define render-rib? #f)
(define *particles* '())    ;; list of live particles
(define (add-particle particle) (set! *particles* (cons particle *particles*)))
(define *num-particles* 2)
(define (randR low high) (+ (* (rand) (- high low)) low))

; 15 fps
(define *dt* 0.2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (particle-create)
  
  (let (
	(mass 1)
	(velocity (vec3 0 0 1))
	(position (vec3 0 0 0))
	(acceleration (vec3 0 0 0))
	(dead? #f)
	)
    
    (define (set-velocity! vel) (set! velocity vel))
    (define (set-position! pos) (set! position pos))
    (define (set-dead! dead) (set! dead? dead))
    
    (define (update)
      (let ((p-list *particles*)
	    (force (vec3 0 0 0))
	    )
	
	;; compute external forces
	(set! force (* mass *gravity*))
	
	;; compute new velocity
	(set! acceleration (/ force mass))
	(set! velocity (+ velocity (* acceleration *dt*)))
	
	;; dampen
	(set! velocity (* velocity *damping*))
	
	;; compute new position
	(set! position (+ position (* velocity *dt*) 
			  (* 0.5 *gravity* *dt* *dt*)))
	
	;; determine if dead
	
	(if (< (ycomp position) -10) (set! dead? #t))
	))

    (define (draw) 
      (separator (translate position) (sphere)))
      
    (lambda (message)
      (cond
       ((eq? message 'set-velocity!) set-velocity!)
       ((eq? message 'set-position!) set-position!)
       ((eq? message 'set-dead!) set-dead!)
       ((eq? message 'velocity) velocity)
       ((eq? message 'position) position)
       ((eq? message 'dead?) dead?)
       ((eq? message 'update) (update))
       ((eq? message 'draw) (draw))
       (else (error "particle: invalid operation" message))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (generate-particles)
  (let (
	(n *num-particles*)
	(particle ())
	)
    (while (> n 0)
	   (begin
	     (set! particle (particle-create))
	     ((particle 'set-velocity!)
		     (vec3 (randR -1 1) (randR 9 11) (randR -1 1)))
	     ((particle 'set-position!) (vec3 0 0 0))
	     
	     (add-particle particle)
	     (set! n (sub1 n))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-particles)
  (define p-list *particles*)
  (while (not (null? p-list))
    (begin
      ((car p-list) 'update)
      (set! p-list (cdr p-list)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (draw-particles)
  (define p-list *particles*)
  (while (not (null? p-list))
    (begin
      ((car p-list) 'draw)
      (set! p-list (cdr p-list)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (remove-dead-particles)

  (define (helper p-list)
    (if (null? p-list) 
	p-list
	(if ((car p-list) 'dead?) 
	    (helper (cdr p-list))
	    (cons (car p-list) (helper (cdr p-list))))))

  (set! *particles* (helper *particles*)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (animate duration)
  (begin 
    (set-time! 0)
    (while (< time duration)
      (begin
	(print time)
	(generate-particles)
	(update-particles)
	(remove-dead-particles)
	(world
	 (camera "main" "perspective" 'from (vec3 59 28 85) 
		 'to (vec3 0 30 0) 'fov 45)
	 (divisions 3 3)
	 (color .7 .2 0)
	 (draw-particles)
	 )

	(if render-rib? 
	    (render 
	     'display-name "frame.~s"
	     'format '(160 121 1)
	     ))
	
	(set-time! (+ time 1))
	))))
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(animate 120)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;