1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
;;; 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-interval
particle-system-emit-count
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-interval
emit-count life-span renderer)
particle-system?
(texture particle-system-texture)
(sprite-rect particle-system-sprite-rect)
(duration particle-system-duration)
(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-interval 1) (emit-count 1)
(life-span 60)
(renderer default-particle-renderer))
"Create a new particle system where each particle is rendered using
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-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-count (particle-system-emit-count particle-system))
(interval (particle-system-emit-interval particle-system))
(duration (particle-system-duration particle-system))
(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 ((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))))))))
|