render: particles: Allow finer control over particle emission.

* sly/render/particles.scm (<particle-system>)[emit-rate]: Delete.
[emit-interval, emit-count]: New fields.
(make-particle-system): Delete emit-rate argument. Add emit-interval and
emit-count arguments.
(render-particles): Rewrite to use emit-rate and emit-count.
* examples/particles.scm: Update example to use new API.

2 files changed, 42 insertions, 32 deletions

diff --git a/examples/particles.scm b/examples/particles.scm
index e9af860..5e7ee7a 100644
--- a/examples/particles.scm
+++ b/examples/particles.scm
@@ -23,7 +23,8 @@
 (load "common.scm")
 
 (define (particle-position n time life-span)
-  (polar2 (* time 2) (* n n)))
+  (polar2 (+ (* time 2) (* (modulo n 17) (/ time 8)))
+          (+ (/ (sin (* n n)) 7) pi/2)))
 
 (define-signal texture
   (on-start (load-texture "images/bullet.png")
@@ -32,13 +33,14 @@
 (define-signal particle-system
   (signal-let ((texture texture))
     (make-particle-system #:texture texture
-                          #:emit-rate 4
-                          #:life-span 200
+                          #:emit-interval 2
+                          #:emit-count 16
+                          #:life-span 60
                           #:renderer (make-simple-particle-renderer
                                       particle-position))))
 
 (define-signal batch
-  (on-start (make-sprite-batch 1024)))
+  (on-start (make-sprite-batch 4096)))
 
 (define-signal scene
   (signal-let ((particle-system particle-system)
@@ -47,7 +49,7 @@
     (if batch
         (with-camera (2d-camera #:area (make-rect 0 0 640 480))
           (with-blend-mode (make-blend-mode 'src-alpha 'one)
-            (move (vector2 320 240)
+            (move (vector2 320 180)
                   (render-particles particle-system batch time))))
         render-nothing)))
 
diff --git a/sly/render/particles.scm b/sly/render/particles.scm
index 88196c5..ca79a04 100644
--- a/sly/render/particles.scm
+++ b/sly/render/particles.scm
@@ -34,7 +34,8 @@
             particle-system?
             particle-system-texture
             particle-system-duration
-            particle-system-emit-rate
+            particle-system-emit-interval
+            particle-system-emit-count
             particle-system-life-span
             particle-system-renderer
             render-particles))
@@ -53,53 +54,60 @@ time, and life span.  PROC must return a 2D vector."
      (polar2 time n))))
 
 (define-record-type <particle-system>
-  (%make-particle-system texture sprite-rect duration emit-rate
-                         life-span renderer)
+  (%make-particle-system texture sprite-rect duration emit-interval
+                         emit-count life-span renderer)
   particle-system?
   (texture particle-system-texture)
   (sprite-rect particle-system-sprite-rect)
   (duration particle-system-duration)
-  (emit-rate particle-system-emit-rate)
+  (emit-interval particle-system-emit-interval)
+  (emit-count particle-system-emit-count)
   (life-span particle-system-life-span)
   (renderer particle-system-renderer))
 
 (define* (make-particle-system #:key (texture null-texture) duration
-                               (emit-rate 1) (life-span 60)
+                               (emit-interval 1) (emit-count 1)
+                               (life-span 60)
                                (renderer default-particle-renderer))
   "Create a new particle system where each particle is rendered using
-TEXTURE.  Particles are emitted at a rate of EMIT-RATE per tick of the
-game clock for DURATION ticks and each particle exists for LIFE-SPAN
-ticks.  The procedure RENDERER is responsible for placing and
-rendering each particle, and takes the following arguments: graphics
-context, sprite batch, texture, sprite rectangle, particle ID, time,
-and life span."
+TEXTURE.  EMIT-COUNT particles are emitted every EMIT-INTERVAL ticks
+of the game clock for DURATION ticks and each particle exists for
+LIFE-SPAN ticks.  The procedure RENDERER is responsible for placing
+and rendering each particle, and takes the following arguments:
+graphics context, sprite batch, texture, sprite rectangle, particle
+ID, time, and life span."
   (let* ((w (texture-width texture))
          (h (texture-height texture))
          (sprite-rect (make-rect (- (/ w 2)) (- (/ h 2)) w h)))
-    (%make-particle-system texture sprite-rect duration emit-rate
-                           life-span renderer)))
+    (%make-particle-system texture sprite-rect duration emit-interval
+                           emit-count life-span renderer)))
 
 (define (render-particles particle-system batch time)
   "Create a renderer for PARTICLE-SYSTEM at TIME.  The particles will
 be rendered using BATCH, a sprite batcher."
   (let* ((life-span (particle-system-life-span particle-system))
-         (emit-rate (particle-system-emit-rate particle-system))
+         (emit-count (particle-system-emit-count particle-system))
+         (interval (particle-system-emit-interval particle-system))
          (duration (particle-system-duration particle-system))
-         (count (* emit-rate life-span))
-         (first (* (- time life-span) emit-rate))
-         (last (if duration
-                   (min (+ first count)
-                        (floor (* duration emit-rate)))
-                   (+ first count)))
+         (first-wave (max (floor (/ (- time life-span) interval)) 0))
+         (last-wave (floor
+                     (/ (if duration
+                            (min time duration)
+                            time)
+                        interval)))
          (render (particle-system-renderer particle-system))
          (texture (particle-system-texture particle-system))
          (sprite-rect (particle-system-sprite-rect particle-system)))
     (lambda (gfx)
       (with-sprite-batch batch gfx
-        (let loop ((particle (max first 0)))
-          (when (< particle last)
-            (let* ((start-time (/ particle emit-rate))
-                   (current-time (- time start-time)))
-              (render gfx batch texture sprite-rect particle
-                      current-time life-span))
-            (loop (1+ particle))))))))
+        (let loop ((w first-wave))
+          (when (<= w last-wave)
+            (let ((life-time (- time (* w interval)))
+                  (first-particle (* w emit-count)))
+              (let loop ((p 0))
+                (when (< p emit-count)
+                  (render gfx batch texture sprite-rect
+                          (+ first-particle p)
+                          life-time life-span)
+                  (loop (1+ p)))))
+            (loop (1+ w))))))))