blob: a734d6a7ec5d93faa78a6b7fa531b83e8ba02397 (
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
|
(define-module (bonnie-bee actor)
#:use-module (chickadee data quadtree)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
#:use-module (oop goops)
#:use-module (starling node)
#:use-module (starling node-2d)
#:export (<actor>
velocity
hitbox
world-hitbox
quadtree
on-collide
<damageable>
dead?
damage
on-death))
(define-class <actor> (<node-2d>)
(velocity #:getter 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 (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)
(pk 'unhandled-collision 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 (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)
(vec2-add! p v)
(refresh-world-hitbox actor)
(collision-check actor)
(add-to-quadtree actor)
(dirty! actor)))))
(define-class <damageable> ()
(health #:accessor health #:init-keyword #:health))
(define-method (dead? (d <damageable>))
(= (health d) 0))
(define-method (damage (d <damageable>) x)
(set! (health d) (max (- (health d) x) 0)))
(define-method (on-death (d <damageable>) bullets)
#t)
|
