diff options
-rw-r--r-- | Makefile.am | 1 | ||||
-rw-r--r-- | examples/particles.scm | 59 | ||||
-rw-r--r-- | sly/render/particles.scm | 105 |
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)))))))) |