blob: ad21bc0ef18aa3b22a1e99264768d3959d179e6a (
plain)
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
|
(library (strigoform particles)
(export make-particle-pool
particle-pool?
particle-pool-add!
particle-pool-reset!
particle-pool-update!
draw-particles
explode)
(import (scheme base)
(scheme inexact)
(hoot match)
(strigoform canvas)
(strigoform math)
(strigoform type))
(define-type particle-pool
%make-particle-pool
particle-pool?
(length particle-pool-length set-particle-pool-length!)
(capacity particle-pool-capacity set-particle-pool-capacity!)
(image particle-pool-image set-particle-pool-image!)
(ticks particle-pool-ticks set-particle-pool-ticks!)
(particles particle-pool-particles set-particle-pool-particles!))
;; per particle: spawn-time, lifespan, tile-x, x, y, dx, dy
(define %particle-size (+ 4 4 8 8 8 8 8))
(define particle-tile-width 8.0)
(define particle-tile-height 8.0)
(define (make-particle-pool capacity image)
(let ((particles (make-bytevector (* capacity %particle-size))))
(%make-particle-pool 0 capacity image 0 particles)))
(define (particle-pool-offset i)
(* i %particle-size))
(define (particle-pool-add! pool type lifespan x y dx dy)
(match pool
(#('particle-pool length capacity image ticks particles)
(let ((offset (particle-pool-offset length))
(tx (* (match type
('muzzle-flash 0.0)
('explosion 1.0)
('hit-wall 2.0))
particle-tile-width)))
(s32-set! particles offset ticks)
(s32-set! particles (+ offset 4) lifespan)
(f64-set! particles (+ offset 8) tx)
(f64-set! particles (+ offset 16) x)
(f64-set! particles (+ offset 24) y)
(f64-set! particles (+ offset 32) dx)
(f64-set! particles (+ offset 40) dy)
(set-particle-pool-length! pool (+ length 1))))))
(define (particle-pool-remove! pool i)
(match pool
(#('particle-pool length capacity image ticks particles)
(when (and (>= i 0) (< i length))
(let ((at (particle-pool-offset i))
(start (particle-pool-offset (- length 1))))
(bytevector-copy! particles at particles start (+ start %particle-size))
(set-particle-pool-length! pool (- length 1)))))))
(define (particle-pool-reset! pool)
(set-particle-pool-length! pool 0))
(define (particle-pool-update! pool)
(match pool
(#('particle-pool length capacity image ticks particles)
(let ((t (+ ticks 1)))
(let loop ((i 0) (k length))
(when (< i k)
(let* ((offset (particle-pool-offset i))
(t* (s32-ref particles offset))
(l (s32-ref particles (+ offset 4)))
(x (f64-ref particles (+ offset 16)))
(y (f64-ref particles (+ offset 24)))
(dx (f64-ref particles (+ offset 32)))
(dy (f64-ref particles (+ offset 40)))
(x* (+ x dx))
(y* (+ y dy)))
(cond
((>= (- t t*) l)
(particle-pool-remove! pool i)
(loop i (- k 1)))
(else
(f64-set! particles (+ offset 16) (+ x dx))
(f64-set! particles (+ offset 24) (+ y dy))
(loop (+ i 1) k))))))
(set-particle-pool-ticks! pool t)))))
(define (draw-particles context pool)
(match pool
(#('particle-pool length capacity image ticks particles)
(do ((i 0 (+ i 1)))
((= i length))
(let* ((offset (particle-pool-offset i))
(tx (f64-ref particles (+ offset 8)))
(x (f64-ref particles (+ offset 16)))
(y (f64-ref particles (+ offset 24))))
(draw-image context image tx 0.0
particle-tile-width particle-tile-height
(- x (/ particle-tile-width 2.0))
(- y (/ particle-tile-height 2.0))
particle-tile-width particle-tile-height))))))
(define (explode particles x y)
(let ((speed 1.0))
(do-circle
(lambda (theta)
(particle-pool-add! particles 'explosion 20 x y
(* (cos theta) speed) (* (sin theta) speed)))
16))))
|
