blob: ecf7b537da8a2461d28b2ed097f4c2b149f44582 (
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
|
(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 (starling asset)
#:use-module (starling node)
#:use-module (starling node-2d)
#:export (<bullet>
type
pollen-pickup
<bullets>
add-bullet))
(define-class <bullet> ()
(type #:getter type #:init-keyword #:type)
(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 bullet)))
(define pollen-pickup
(make <bullet> #:type '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 thunk)
(let ((v (make-vector size)))
(for-range ((i size))
(vector-set! v i (thunk)))
v))
(define (make-null-vec2)
(vec2 0.0 0.0))
(define (make-null-rect)
(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 #:getter descriptors #:init-form (make-vector %max-bullets #f))
(velocities #:getter velocities
#:init-form (make-vector* %max-bullets make-null-vec2))
(hitboxes #:getter hitboxes
#:init-form (make-vector* %max-bullets make-null-rect))
(regions #:getter regions
#:init-form (make-vector* %max-bullets make-null-rect)))
(define-method (add-bullet (bullets <bullets>) bullet position velocity)
(let ((i (size bullets)))
(when (< i (capacity bullets))
(let ((bh (hitbox bullet))
(v (vector-ref (velocities bullets) i))
(h (vector-ref (hitboxes bullets) i))
(r (vector-ref (regions bullets) i)))
(vector-set! (descriptors bullets) i bullet)
(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) r bullet)))))
(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))
(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))
(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 r 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 (< (rect-left h) -16.0)
(> (rect-right h) 336.0)
(< (rect-bottom h) -16.0)
(> (rect-top h) 256.0))
(pk 'remove i)
(remove-bullet bullets i)
(loop i))
((and (= (vec2-x v) 0.0)
(= (vec2-y v) 0.0))
(loop (+ i 1)))
(else
(quadtree-delete! q r 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-find
(quadtree bullets) r
(lambda (other)
;; Calculate overlap.
(if (is-a? other <actor>)
(let* ((ro (world-hitbox other))
(xo (max (- (min (rect-right r) (rect-right ro))
(max (rect-left r) (rect-left ro)))
0.0))
(yo (max (- (min (rect-top r) (rect-top ro))
(max (rect-bottom r) (rect-bottom ro)))
0.0)))
(if (or (= xo 0.0) (= yo 0.0))
#f ; no collision
(on-collide d other)))
#f)))
(quadtree-insert! q r d)
(loop (+ i 1)))))))))
|
