summaryrefslogtreecommitdiff
path: root/bonnie-bee/actor.scm
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)