render: Add particle effects.

* sly/render/particles.scm: New file.
* Makefile.am (SOURCES): Add it.
* examples/particles.scm: New file.

3 files changed, 165 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index d6363ac..0db0854 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -47,6 +47,7 @@ SOURCES = 					\
   sly/render/framebuffer.scm			\
   sly/render/mesh.scm				\
   sly/render/nine-patch.scm			\
+  sly/render/particles.scm			\
   sly/render/texture.scm			\
   sly/render/shader.scm				\
   sly/render/shape.scm				\
diff --git a/examples/particles.scm b/examples/particles.scm
new file mode 100644
index 0000000..e9af860
--- /dev/null
+++ b/examples/particles.scm
@@ -0,0 +1,59 @@
+;;; Sly
+;;; Copyright (C) 2016 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(use-modules (sly)
+             (sly render particles)
+             (sly render sprite-batch)
+             (sly render utils))
+
+(load "common.scm")
+
+(define (particle-position n time life-span)
+  (polar2 (* time 2) (* n n)))
+
+(define-signal texture
+  (on-start (load-texture "images/bullet.png")
+            null-texture))
+
+(define-signal particle-system
+  (signal-let ((texture texture))
+    (make-particle-system #:texture texture
+                          #:emit-rate 4
+                          #:life-span 200
+                          #:renderer (make-simple-particle-renderer
+                                      particle-position))))
+
+(define-signal batch
+  (on-start (make-sprite-batch 1024)))
+
+(define-signal scene
+  (signal-let ((particle-system particle-system)
+               (batch batch)
+               (time (signal-timer)))
+    (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)
+                  (render-particles particle-system batch time))))
+        render-nothing)))
+
+(with-window (make-window #:title "Particles")
+  (run-game-loop scene))
+
+;;; Local Variables:
+;;; compile-command: "../pre-inst-env guile particles.scm"
+;;; End:
diff --git a/sly/render/particles.scm b/sly/render/particles.scm
new file mode 100644
index 0000000..88196c5
--- /dev/null
+++ b/sly/render/particles.scm
@@ -0,0 +1,105 @@
+;;; Sly
+;;; Copyright (C) 2016 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Particle simulations.
+;;
+;;; Code:
+
+(define-module (sly render particles)
+  #:use-module (srfi srfi-9)
+  #:use-module (sly math vector)
+  #:use-module (sly math rect)
+  #:use-module (sly render)
+  #:use-module (sly render mesh)
+  #:use-module (sly render texture)
+  #:use-module (sly render sprite-batch)
+  #:export (make-simple-particle-renderer
+            make-particle-system
+            particle-system?
+            particle-system-texture
+            particle-system-duration
+            particle-system-emit-rate
+            particle-system-life-span
+            particle-system-renderer
+            render-particles))
+
+(define (make-simple-particle-renderer proc)
+  "Create a particle renderer using PROC to define the position of
+each particle.  PROC must accept 3 numeric arguments: the particle ID,
+time, and life span.  PROC must return a 2D vector."
+  (lambda (gfx batch texture rect n time life-span)
+    (let* ((v (proc n time life-span)))
+      (sprite-batch-add! batch gfx texture (rect-move rect v)))))
+
+(define default-particle-renderer
+  (make-simple-particle-renderer
+   (lambda (n time life-span)
+     (polar2 time n))))
+
+(define-record-type <particle-system>
+  (%make-particle-system texture sprite-rect duration emit-rate
+                         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)
+  (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)
+                               (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."
+  (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)))
+
+(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))
+         (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)))
+         (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))))))))