1 files changed, 27 insertions, 8 deletions
diff --git a/lisparuga/actor.scm b/lisparuga/actor.scm
index c7caab2..5439e6b 100644
--- a/lisparuga/actor.scm
+++ b/lisparuga/actor.scm
@@ -28,6 +28,7 @@
   #:use-module (lisparuga node)
   #:use-module (lisparuga node-2d)
   #:use-module (oop goops)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:export (make-hitbox
             hitbox?
@@ -43,6 +44,7 @@
             velocity
             hitboxes
             world-hitboxes
+            collide
             on-collision
             bullet-field))
 
@@ -69,7 +71,10 @@
                         (make-rect 0.0 0.0 (rect-width r) (rect-height r)))))
 
 (define (sync-world-hitbox world-hitbox position)
-  (rect-move-vec2! (world-hitbox-rect world-hitbox) position))
+  (let ((r (hitbox-rect (world-hitbox-parent world-hitbox)))
+        (wr (world-hitbox-rect world-hitbox)))
+    (set-rect-x! wr (+ (vec2-x position) (rect-x r)))
+    (set-rect-y! wr (+ (vec2-y position) (rect-y r)))))
 
 (define (world-hitbox-collision? a b)
   (if (world-hitbox? b)
@@ -88,10 +93,18 @@
   (world-hitboxes #:accessor world-hitboxes #:init-form '())
   (bullet-field #:accessor bullet-field #:init-keyword #:bullet-field))
 
+(define (sync-hitboxes actor)
+  ;; Sync hitboxes to world coordinates.
+  (let ((pos (position actor)))
+    (for-each (lambda (world-hitbox)
+                (sync-world-hitbox world-hitbox pos))
+              (world-hitboxes actor))))
+
 (define-method (initialize (actor <actor>) initargs)
   (next-method)
   (set! (world-hitboxes actor)
-    (map make-world-hitbox (hitboxes actor))))
+    (map make-world-hitbox (hitboxes actor)))
+  (sync-hitboxes actor))
 
 (define-method (update (actor <actor>) dt)
   (let ((v (velocity actor)))
@@ -99,15 +112,21 @@
                  (= (vec2-y v) 0.0))
       ;; Move by current velocity.
       (vec2-add! (position actor) v)
-      ;; Sync hitboxes to world coordinates.
-      (let ((pos (position actor)))
-        (for-each (lambda (world-hitbox)
-                    (sync-world-hitbox world-hitbox pos))
-                  (world-hitboxes actor)))
+      (sync-hitboxes actor)
       ;; Mark for matrix updates.
       (dirty! actor))))
 
+(define-method (collide (actor <actor>) (other-actor <actor>))
+  (any (lambda (wh)
+         (any (lambda (other-wh)
+                (and (world-hitbox-collision? wh other-wh)
+                     (on-collision actor other-actor
+                                   (world-hitbox-parent wh)
+                                   (world-hitbox-parent other-wh))))
+              (world-hitboxes other-actor)))
+       (world-hitboxes actor)))
+
 ;; Actor-actor collision event.
 (define-method (on-collision (actor <actor>) (other-actor <actor>)
                              hitbox other-hitbox)
-  #t)
+  #f)