1 files changed, 67 insertions, 0 deletions
diff --git a/bonnie-bee/actor.scm b/bonnie-bee/actor.scm
new file mode 100644
index 0000000..db49372
--- /dev/null
+++ b/bonnie-bee/actor.scm
@@ -0,0 +1,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))))