blob: db49372336093442a3300d601a7b637b960e761e (
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
|
(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))
(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 (update (actor <actor>) dt)
(let ((p (position actor))
(v (velocity actor))
(r (world-hitbox actor)))
(unless (and (= (vec2-x v) 0.0) (= (vec2-y v) 0.0))
(remove-from-quadtree actor)
(vec2-add! p v)
(refresh-world-hitbox actor)
(quadtree-find
(quadtree actor) r
(lambda (other)
;; Calculate overlap.
(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 actor other)))))
(add-to-quadtree actor)
(dirty! actor))))
|
