summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/render/particles.scm221
1 files changed, 105 insertions, 116 deletions
diff --git a/chickadee/render/particles.scm b/chickadee/render/particles.scm
index 5afae81..7e79dda 100644
--- a/chickadee/render/particles.scm
+++ b/chickadee/render/particles.scm
@@ -77,7 +77,7 @@ indefinitely."
(and life (<= life 0))))
(define-record-type <particles>
- (%make-particles capacity size buffer shader vertex-array
+ (%make-particles capacity size bv buffer shader vertex-array
texture animation-rows animation-columns
speed-range acceleration-range direction-range
blend-mode start-color end-color lifetime
@@ -85,6 +85,7 @@ indefinitely."
particles?
(capacity particles-capacity)
(size particles-size set-particles-size!)
+ (bv particles-bv)
(buffer particles-buffer)
(shader particles-shader)
(vertex-array particles-vertex-array)
@@ -285,11 +286,13 @@ default.
;; One extra element to use as
;; swap space for sorting
;; particles.
- #:length (* stride (+ capacity 1))
+ #:length (* stride capacity)
#:stride stride
#:usage 'stream)))
(%make-particles capacity
0
+ ;; 1 extra element as swap space for sorting.
+ (make-bytevector (* (+ capacity 1) stride))
buffer
(make-particles-shader)
(make-particles-vertex-array capacity
@@ -330,121 +333,107 @@ default.
(ddx-offset 16)
(ddy-offset 20)
(life-offset 24))
- (with-mapped-buffer buffer
- (let* ((bv (buffer-data buffer))
- (stride (buffer-stride buffer))
- (current-size (particles-size particles)))
- ;; Remove particles in batches since often a bunch of
- ;; contiguous particles die at the same time.
- (define (kill-range start end len)
- (when start
- (bytevector-copy! bv len
- bv start
- (- end start))))
- ;; Update existing particles, removing dead ones.
- (let loop ((i 0)
- (len (* current-size stride))
- (kill-start #f))
- (if (< i len)
- (let ((life (- (int-ref bv (+ i life-offset)) 1)))
- (cond
- ((<= life 0)
- (loop (+ i stride) (- len stride) (or kill-start i)))
- (kill-start
- (kill-range kill-start i len)
- (loop kill-start len #f))
- (else
- (let ((x (float-ref bv i))
- (y (float-ref bv (+ i y-offset)))
- (dx (float-ref bv (+ i dx-offset)))
- (dy (float-ref bv (+ i dy-offset)))
- (ddx (float-ref bv (+ i ddx-offset)))
- (ddy (float-ref bv (+ i ddy-offset))))
- (int-set! bv (+ i life-offset) life)
- (float-set! bv i (+ x dx))
- (float-set! bv (+ i y-offset) (+ y dy))
- (float-set! bv (+ i dx-offset) (+ dx ddx))
- (float-set! bv (+ i dy-offset) (+ dy ddy))
- (loop (+ i stride) len #f)))))
- (if kill-start
+ (let* ((bv (particles-bv particles))
+ (stride (buffer-stride buffer))
+ (capacity (particles-capacity particles)))
+ ;; Update existing particles, removing dead ones.
+ (let loop ((i 0)
+ (size (particles-size particles)))
+ (if (< i size)
+ (let* ((offset (* i stride))
+ (life (- (int-ref bv (+ offset life-offset)) 1)))
+ (if (<= life 0)
+ (let ((new-size (- size 1)))
+ (bytevector-copy! bv (* new-size stride) bv offset stride)
+ (loop i new-size))
+ (let ((x (float-ref bv offset))
+ (y (float-ref bv (+ offset y-offset)))
+ (dx (float-ref bv (+ offset dx-offset)))
+ (dy (float-ref bv (+ offset dy-offset)))
+ (ddx (float-ref bv (+ offset ddx-offset)))
+ (ddy (float-ref bv (+ offset ddy-offset))))
+ (int-set! bv (+ offset life-offset) life)
+ (float-set! bv offset (+ x dx))
+ (float-set! bv (+ offset y-offset) (+ y dy))
+ (float-set! bv (+ offset dx-offset) (+ dx ddx))
+ (float-set! bv (+ offset dy-offset) (+ dy ddy))
+ (loop (+ i 1) size))))
+ (set-particles-size! particles size)))
+ ;; Add particles from each active emitter and then remove
+ ;; emitters that have completed.
+ (let ((sx (vec2-x speed-range))
+ (sy (vec2-y speed-range))
+ (ax (vec2-x acceleration-range))
+ (ay (vec2-y acceleration-range))
+ (dx (vec2-x direction-range))
+ (dy (vec2-y direction-range))
+ (emitters (particles-emitters particles)))
+ (define (emit emitter any-done?)
+ (let* ((spawn-area (particle-emitter-spawn-area emitter))
+ (rate (particle-emitter-rate emitter))
+ (rx (rect-x spawn-area))
+ (ry (rect-y spawn-area))
+ (rw (rect-width spawn-area))
+ (rh (rect-height spawn-area))
+ (start (particles-size particles))
+ (end (min (+ start rate) capacity)))
+ (let loop ((i start))
+ (if (< i end)
+ (let* ((offset (* i stride))
+ (speed (+ (* (random:uniform) (- sy sx)) sx))
+ (accel (+ (* (random:uniform) (- ay ax)) ax))
+ (dir (+ (* (random:uniform) (- dy dx)) dx))
+ (dir-x (cos dir))
+ (dir-y (sin dir)))
+ (float-set! bv offset (+ rx (* (random:uniform) rw)))
+ (float-set! bv (+ offset y-offset)
+ (+ ry (* (random:uniform) rh)))
+ (float-set! bv (+ offset dx-offset) (* dir-x speed))
+ (float-set! bv (+ offset dy-offset) (* dir-y speed))
+ (float-set! bv (+ offset ddx-offset) (* dir-x accel))
+ (float-set! bv (+ offset ddy-offset) (* dir-y accel))
+ (int-set! bv (+ offset life-offset) lifetime)
+ (loop (+ i 1)))
(begin
- (kill-range kill-start len len)
- (loop kill-start len #f))
- (set-particles-size! particles (/ len stride)))))
- ;; Add particles from each active emitter and then remove
- ;; emitters that have completed.
- (let ((sx (vec2-x speed-range))
- (sy (vec2-y speed-range))
- (ax (vec2-x acceleration-range))
- (ay (vec2-y acceleration-range))
- (dx (vec2-x direction-range))
- (dy (vec2-y direction-range))
- (emitters (particles-emitters particles))
- (len (- (bytevector-length bv) stride)))
- (define (emit emitter any-done?)
- (let* ((size (particles-size particles))
- (spawn-area (particle-emitter-spawn-area emitter))
- (rate (particle-emitter-rate emitter))
- (rx (rect-x spawn-area))
- (ry (rect-y spawn-area))
- (rw (rect-width spawn-area))
- (rh (rect-height spawn-area))
- (start (* size stride))
- (end (min (+ start (* rate stride)) len)))
- (let loop ((i start))
- (if (< i end)
- (let* ((speed (+ (* (random:uniform) (- sy sx)) sx))
- (accel (+ (* (random:uniform) (- ay ax)) ax))
- (dir (+ (* (random:uniform) (- dy dx)) dx))
- (dir-x (cos dir))
- (dir-y (sin dir)))
- (float-set! bv i (+ rx (* (random:uniform) rw)))
- (float-set! bv (+ i y-offset)
- (+ ry (* (random:uniform) rh)))
- (float-set! bv (+ i dx-offset) (* dir-x speed))
- (float-set! bv (+ i dy-offset) (* dir-y speed))
- (float-set! bv (+ i ddx-offset) (* dir-x accel))
- (float-set! bv (+ i ddy-offset) (* dir-y accel))
- (int-set! bv (+ i life-offset) lifetime)
- (loop (+ i stride)))
- (begin
- (set-particles-size! particles (/ end stride))
- (update-particle-emitter emitter)
- (or any-done? (particle-emitter-done? emitter)))))))
- (when (fold emit #f emitters)
- (set-particles-emitters! particles
- (remove particle-emitter-done? emitters))))
- ;; Sort particles.
- (when sort
- (let ((compare (cond
- ((eq? sort 'young)
- (lambda (i j)
- (< (int-ref bv (+ i life-offset))
- (int-ref bv (+ j life-offset)))))
- ((eq? sort 'old)
- (lambda (i j)
- (> (int-ref bv (+ i life-offset))
- (int-ref bv (+ j life-offset)))))
- (else
- (error "unknown particle sorting method" sort))))
- (tmp (* (particles-capacity particles) stride)))
- (define (swap i j)
- (bytevector-copy! bv i bv tmp stride)
- (bytevector-copy! bv j bv i stride)
- (bytevector-copy! bv tmp bv j stride))
- ;; In the benchmarks I've done, insertion sort has
- ;; performed much better than quicksort here. The number
- ;; of comparisons and swaps is much fewer.
- (define (sort start end)
- (let outer ((i (+ start stride)))
- (when (< i end)
- (let inner ((j i))
- (when (and (> j start)
- (compare j (- j stride)))
- (swap (- j stride) j)
- (inner (- j stride))))
- (outer (+ i stride)))))
- (sort 0 (* (particles-size particles) stride))))))))
+ (set-particles-size! particles end)
+ (update-particle-emitter emitter)
+ (or any-done? (particle-emitter-done? emitter)))))))
+ (when (fold emit #f emitters)
+ (set-particles-emitters! particles
+ (remove particle-emitter-done? emitters))))
+ ;; Sort particles.
+ (when sort
+ (let ((compare (cond
+ ((eq? sort 'young)
+ (lambda (i j)
+ (< (int-ref bv (+ i life-offset))
+ (int-ref bv (+ j life-offset)))))
+ ((eq? sort 'old)
+ (lambda (i j)
+ (> (int-ref bv (+ i life-offset))
+ (int-ref bv (+ j life-offset)))))
+ (else
+ (error "unknown particle sorting method" sort))))
+ (tmp (* (particles-capacity particles) stride)))
+ (define (swap i j)
+ (bytevector-copy! bv i bv tmp stride)
+ (bytevector-copy! bv j bv i stride)
+ (bytevector-copy! bv tmp bv j stride))
+ ;; In the benchmarks I've done, insertion sort has
+ ;; performed much better than quicksort here. The number
+ ;; of comparisons and swaps is much fewer.
+ (define (sort start end)
+ (let outer ((i (+ start stride)))
+ (when (< i end)
+ (let inner ((j i))
+ (when (and (> j start)
+ (compare j (- j stride)))
+ (swap (- j stride) j)
+ (inner (- j stride))))
+ (outer (+ i stride)))))
+ (sort 0 (* (particles-size particles) stride))))
+ (with-mapped-buffer buffer
+ (bytevector-copy! bv 0 (buffer-data buffer) 0 (* (particles-size particles) stride))))))
(define draw-particles*
(let ((mvp (make-null-matrix4)))