blob: 0fb351b614a0294cac9d66726b2389fa49969f6a (
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
(define-module (bonnie-bee bullet)
#:use-module (bonnie-bee actor)
#:use-module (bonnie-bee assets)
#:use-module (chickadee data quadtree)
#:use-module (chickadee graphics sprite)
#:use-module (chickadee graphics texture)
#:use-module (chickadee math matrix)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
#:use-module (chickadee utils)
#:use-module (oop goops)
#:use-module (srfi srfi-9)
#:use-module (starling asset)
#:use-module (starling node)
#:use-module (starling node-2d)
#:export (<bullet-type>
name
player-primary-bullet
pollen-pickup
<bullets>
<bullet>
type
kill-bullet
add-bullet))
(define-class <bullet-type> ()
(name #:getter name #:init-keyword #:name)
(atlas-index #:getter atlas-index #:init-keyword #:atlas-index)
(hitbox #:getter hitbox #:init-keyword #:hitbox))
(define (bullet-texture bullet)
(texture-atlas-ref (asset-ref bullet-atlas)
(atlas-index (type bullet))))
(define player-primary-bullet
(make <bullet-type> #:name 'player-primary #:atlas-index 4
#:hitbox (make-rect -7.0 -7.0 14.0 14.0)))
;; Yeah... pollen is a bullet. Didn't you know that??
(define pollen-pickup
(make <bullet-type> #:name 'pollen #:atlas-index 6
#:hitbox (make-rect -10.0 -10.0 20.0 20.0)))
(define (make-bullet-sprite-batch)
(make-sprite-batch
(texture-parent
(texture-atlas-ref (asset-ref bullet-atlas) 0))))
(define (make-vector* size proc)
(let ((v (make-vector size)))
(for-range ((i size))
(vector-set! v i (proc i)))
v))
(define (make-null-vec2 i)
(vec2 0.0 0.0))
(define (make-null-rect i)
(make-rect 0.0 0.0 0.0 0.0))
(define %max-bullets 2048)
(define %identity-matrix (make-identity-matrix4))
(define-class <bullets> (<node-2d>)
(quadtree #:getter quadtree #:init-keyword #:quadtree)
(batch #:getter batch #:init-thunk make-bullet-sprite-batch)
(capacity #:getter capacity #:init-value %max-bullets)
(size #:accessor size #:init-value 0)
(descriptors #:accessor descriptors)
(velocities #:accessor velocities)
(hitboxes #:accessor hitboxes)
(regions #:accessor regions))
(define-method (initialize (bullets <bullets>) args)
(define (make-descriptor i)
(make <bullet> #:parent bullets #:index i))
(next-method)
(set! (descriptors bullets) (make-vector* %max-bullets make-descriptor))
(set! (velocities bullets) (make-vector* %max-bullets make-null-vec2))
(set! (hitboxes bullets) (make-vector* %max-bullets make-null-rect))
(set! (regions bullets) (make-vector* %max-bullets make-null-rect)))
(define-class <bullet> ()
(parent #:getter parent #:init-keyword #:parent)
(type #:accessor type)
(index #:accessor index #:init-keyword #:index)
(alive? #:accessor alive? #:init-value #f))
(define-method (dead? (bullet <bullet>))
(not (alive? bullet)))
(define-method (kill-bullet (bullet <bullet>))
(set! (alive? bullet) #f))
(define-method (velocity (bullet <bullet>))
(vector-ref (velocities (parent bullet)) (index bullet)))
(define-method (world-hitbox (bullet <bullet>))
(vector-ref (hitboxes (parent bullet)) (index bullet)))
(define-method (add-bullet (bullets <bullets>) bullet-type position velocity)
(let ((i (size bullets)))
(when (< i (capacity bullets))
(let ((bh (hitbox bullet-type))
(d (vector-ref (descriptors bullets) i))
(v (vector-ref (velocities bullets) i))
(h (vector-ref (hitboxes bullets) i))
(r (vector-ref (regions bullets) i)))
(set! (type d) bullet-type)
(set! (alive? d) #t)
(vec2-copy! velocity (vector-ref (velocities bullets) i))
(set-rect-x! h (+ (vec2-x position) (rect-x bh)))
(set-rect-y! h (+ (vec2-y position) (rect-y bh)))
(set-rect-width! h (rect-width bh))
(set-rect-height! h (rect-height bh))
(set-rect-x! r (- (vec2-x position) 8.0))
(set-rect-y! r (- (vec2-y position) 8.0))
(set-rect-width! r 16.0)
(set-rect-height! r 16.0)
(set! (size bullets) (+ i 1))
(quadtree-insert! (quadtree bullets) h d)))))
(define-method (remove-bullet (bullets <bullets>) i)
(let* ((s (- (size bullets) 1))
(ds (descriptors bullets))
(rs (regions bullets))
(vs (velocities bullets))
(hs (hitboxes bullets))
(q (quadtree bullets))
(d (vector-ref ds i))
(r (vector-ref rs i))
(v (vector-ref vs i))
(h (vector-ref hs i)))
(when (or (> i s) (< i 0))
(error "bullet index out of bounds" i))
(set! (index (vector-ref ds s)) i)
(vector-set! ds i (vector-ref ds s))
(vector-set! rs i (vector-ref rs s))
(vector-set! vs i (vector-ref vs s))
(vector-set! hs i (vector-ref hs s))
(set! (index d) s)
(vector-set! ds s d)
(vector-set! rs s r)
(vector-set! vs s v)
(vector-set! hs s h)
(set! (size bullets) s)
(quadtree-delete! q h d)))
(define-method (render (bullets <bullets>) alpha)
(let ((ds (descriptors bullets))
(rs (regions bullets))
(b (batch bullets)))
(sprite-batch-clear! b)
(for-range ((i (size bullets)))
(let ((d (vector-ref ds i))
(r (vector-ref rs i)))
(sprite-batch-add* b r %identity-matrix
#:texture-region (bullet-texture d))))
(draw-sprite-batch* b (world-matrix bullets))))
(define-method (update (bullets <bullets>) dt)
(let ((ds (descriptors bullets))
(rs (regions bullets))
(vs (velocities bullets))
(hs (hitboxes bullets))
(q (quadtree bullets)))
(let loop ((i 0))
(when (< i (size bullets))
(let ((d (vector-ref ds i))
(r (vector-ref rs i))
(v (vector-ref vs i))
(h (vector-ref hs i)))
(cond
((or (dead? d)
(< (rect-left h) -16.0)
(> (rect-right h) 336.0)
(< (rect-bottom h) -16.0)
(> (rect-top h) 256.0))
(remove-bullet bullets i)
(loop i))
((and (= (vec2-x v) 0.0)
(= (vec2-y v) 0.0))
(loop (+ i 1)))
(else
(quadtree-delete! q h d)
(set-rect-x! r (+ (rect-x r) (vec2-x v)))
(set-rect-y! r (+ (rect-y r) (vec2-y v)))
(set-rect-x! h (+ (rect-x h) (vec2-x v)))
(set-rect-y! h (+ (rect-y h) (vec2-y v)))
(quadtree-insert! q h d)
(loop (+ i 1)))))))))
|
