From 45791c1360c98957ebe27655d59a2ae9db6cd709 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 4 Jun 2023 09:25:06 -0400
Subject: Giant code and assets drop.

---
 super-bloom/actor.scm | 99 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 99 insertions(+)
 create mode 100644 super-bloom/actor.scm

(limited to 'super-bloom/actor.scm')

diff --git a/super-bloom/actor.scm b/super-bloom/actor.scm
new file mode 100644
index 0000000..0ba495f
--- /dev/null
+++ b/super-bloom/actor.scm
@@ -0,0 +1,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)))))
-- 
cgit v1.2.3