blob: 3d693ddcb44d2f6f520f2193f9c51edcb28e5281 (
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
|
(define-module (bonnie-bee actor)
#:use-module (bonnie-bee assets)
#:use-module (bonnie-bee common)
#:use-module (chickadee audio)
#:use-module (chickadee data quadtree)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
#:use-module (oop goops)
#:use-module (catbird asset)
#:use-module (catbird node)
#:use-module (catbird node-2d)
#:use-module (catbird scene)
#:export (<actor>
velocity
hitbox
world-hitbox
quadtree
change-velocity
direction-to
angle-to
after-move
on-collide
dead?
out-of-bounds?
<damageable>
health
points
damage
on-death
<grounded>
player
bullets
scroll-speed
spawn))
(define-class <actor> (<node-2d>)
(velocity #:getter velocity #:init-keyword #:velocity #:init-form (vec2 0.0 0.0))
(hitbox #:getter hitbox #:init-keyword #:hitbox)
(world-hitbox #:getter world-hitbox #:init-form (make-rect 0.0 0.0 0.0 0.0))
(quadtree #:accessor quadtree #:init-keyword #:quadtree))
(define-method (change-velocity (actor <actor>) dx dy)
(set-vec2! (velocity actor) dx dy))
(define-method (direction-to (actor <actor>) (other <actor>))
(let ((dir (vec2- (position other) (position actor))))
(vec2-normalize! dir)
dir))
(define-method (angle-to (actor <actor>) (other <actor>))
(let ((p1 (position actor))
(p2 (position other)))
(atan (- (vec2-y p2) (vec2-y p1))
(- (vec2-x p2) (vec2-x p1)))))
(define-method (scroll-speed (actor <actor>))
0.0)
(define-method (add-to-quadtree (actor <actor>))
(quadtree-insert! (quadtree actor) (world-hitbox actor) actor))
(define-method (remove-from-quadtree (actor <actor>))
(quadtree-delete! (quadtree actor) (world-hitbox actor) actor))
(define-method (refresh-world-hitbox (actor <actor>))
(let ((p (position actor))
(h (hitbox actor))
(wh (world-hitbox actor)))
(set-rect-x! wh (+ (vec2-x p) (rect-x h)))
(set-rect-y! wh (+ (vec2-y p) (rect-y h)))
(set-rect-width! wh (rect-width h))
(set-rect-height! wh (rect-height h))))
(define-method (on-collide a b)
#f)
(define-method (on-enter (actor <actor>))
(refresh-world-hitbox actor)
(add-to-quadtree actor))
(define-method (collision-check (actor <actor>))
(let ((p (position actor))
(r (world-hitbox actor)))
(quadtree-find
(quadtree actor) r
(lambda (other)
(and (not (eq? other actor))
(rect-intersects? r (world-hitbox other))
(on-collide actor other))))))
(define-method (after-move (actor <actor>))
#t)
(define-method (update (actor <actor>) dt)
(let ((p (position actor))
(v (velocity actor))
(scroll-speed (scroll-speed actor)))
(if (and (= (vec2-x v) 0.0)
(= (vec2-y v) 0.0)
(= scroll-speed 0.0))
(collision-check actor)
(begin
(remove-from-quadtree actor)
(set-vec2! p
(+ (vec2-x p) (vec2-x v))
(+ (vec2-y p) (vec2-y v) (- (* scroll-speed dt))))
(after-move actor)
(refresh-world-hitbox actor)
(collision-check actor)
(add-to-quadtree actor)
(expire-local-matrix actor)))))
(define-method (dead? (actor <actor>))
#f)
(define-method (dead? x)
#f)
(define %bounds
(let ((padding 16.0))
(make-rect (- padding)
(- padding)
(+ %game-width (* padding 2.0))
(+ %game-height (* padding 2.0)))))
(define-method (out-of-bounds? (actor <actor>))
(not (rect-intersects? (world-hitbox actor) %bounds)))
(define-method (out-of-bounds? x)
#f)
(define-class <damageable> ()
(health #:accessor health #:init-keyword #:health)
(points #:getter points #:init-keyword #:points))
(define-method (dead? (d <damageable>))
(= (health d) 0))
(define-method (damage (d <damageable>) x)
(set! (health d) (max (- (health d) x) 0))
(unless (dead? d)
(audio-play (artifact enemy-hit-sound) #:volume 0.25)))
(define-method (on-death (d <damageable>))
#t)
(define-class <grounded> ())
(define-method (scroll-speed (g <grounded>))
(scroll-speed (parent g)))
(define-generic player)
(define-generic bullets)
(define-generic spawn)
|
