blob: 0ba495f030edaaa692b09787747523d87ab114cf (
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
|
(define-module (super-bloom actor)
#:use-module (catbird asset)
#:use-module (catbird node)
#:use-module (catbird node-2d)
#:use-module (chickadee audio)
#:use-module (chickadee data quadtree)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
#:use-module (oop goops)
#:export (<actor>
velocity
hitbox
world-hitbox
quadtree
change-velocity
direction-to
angle-to
after-move
on-collide
refresh-world-hitbox))
(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 (initialize (actor <actor>) initargs)
(next-method)
(refresh-world-hitbox actor))
(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 (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 (on-exit (actor <actor>))
(remove-from-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)))
(if (and (= (vec2-x v) 0.0)
(= (vec2-y v) 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)))
(after-move actor)
(refresh-world-hitbox actor)
(collision-check actor)
(add-to-quadtree actor)
(expire-local-matrix actor)))))
|
