From f1afd9e177367ec2e6273d9e75b0fb830d2d9ade Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 22 May 2024 13:36:00 -0400
Subject: [PATCH] Player always ticks first.

---
 modules/game/actors.scm | 59 +++++++++++++++++++++++------------------
 1 file changed, 33 insertions(+), 26 deletions(-)

diff --git a/modules/game/actors.scm b/modules/game/actors.scm
index dd59fa1..e8eb0f1 100644
--- a/modules/game/actors.scm
+++ b/modules/game/actors.scm
@@ -377,8 +377,6 @@
           ('down #(0 1))
           (_ (error "invalid direction" dir)))))
     (('tick grid-info)
-     ;; Search for objects that were fine to step onto last turn, but
-     ;; have become deadly this turn.  If
      (match ($ position)
        (#(x y z)
         ($ event #f)
@@ -387,16 +385,13 @@
            ($ position (vector (+ x dx) (+ y dy) z))
            ($ velocity #(0 0)))))))
     (('post-tick grid-info)
+     ;; Search for objects that were fine to step onto last turn, but
+     ;; have become deadly this turn.
      (match ($ position)
        (#(x y z)
         (let lp ((objs ($ grid-info 'occupants x y)))
           (match objs
-            ;; All is well.  Move by current velocity.
-            (()
-             (match ($ velocity)
-               (#(dx dy)
-                ($ position (vector (+ x dx) (+ y dy) z))
-                ($ velocity #(0 0)))))
+            (() #f)
             ((obj . rest)
              (match ($ obj 'type)
                ('gate
@@ -438,6 +433,7 @@
     (('event) ($ event))))
 
 (define (^level bcom width height)
+  (define player (spawn ^cell))
   (define objects (spawn ^cell '()))
 
   ;; Spatial partition
@@ -579,30 +575,41 @@
             (if ($ obj 'alive?)
                 (cons obj (lp rest))
                 (lp rest)))))))
+  (define (tick-object obj)
+    (let ((prev-pos ($ obj 'position)))
+      ($ obj 'tick grid-info)
+      ;; Only check collisions for movable objects.
+      (let ((desired-pos ($ obj 'position)))
+        (unless (equal? prev-pos desired-pos)
+          (collide obj desired-pos prev-pos)))))
   (define (tick)
-    ;; Tick each object and check for collisions.
-    (iter-objects
-     (lambda (obj)
-       (let ((prev-pos ($ obj 'position)))
-         ($ obj 'tick grid-info)
-         ;; Only check collisions for movable objects.
-         (let ((desired-pos ($ obj 'position)))
-           (unless (equal? prev-pos desired-pos)
-             (collide obj desired-pos prev-pos))))))
-    ;; Advance Wirewold simulation.
-    (refresh-wire-grid)
-    (for-each (lambda (obj)
-                ($ obj 'update-wire-state grid-info))
-              ($ objects))
-    ;; Run post-tick hooks.
-    (iter-objects (lambda (obj) ($ obj 'post-tick grid-info))))
+    (let ((player ($ player)))
+      ;; Player goes first.
+      (when ($ player 'alive?)
+        (tick-object player))
+      ;; Tick all the non-player objects.
+      (iter-objects tick-object)
+      ;; Advance Wirewold simulation.
+      (refresh-wire-grid)
+      (for-each (lambda (obj)
+                  ($ obj 'update-wire-state grid-info))
+                ($ objects))
+      ;; Run post-tick hooks.
+      ($ player 'post-tick grid-info)
+      (iter-objects (lambda (obj) ($ obj 'post-tick grid-info)))))
 
   (match-lambda*
     (('tick) (tick))
     (('describe)
-     (map (lambda (obj) ($ obj 'describe)) ($ objects)))
+     (let ((player ($ player))
+           (obj-descs (map (lambda (obj) ($ obj 'describe)) ($ objects))))
+       (if ($ player 'alive?)
+           (cons ($ player 'describe) obj-descs)
+           obj-descs)))
     (('add-object obj)
-     ($ objects (cons obj ($ objects)))
+     (if (eq? ($ obj 'type) 'player)
+         ($ player obj)
+         ($ objects (cons obj ($ objects))))
      (match ($ obj 'position)
        (#(x y _)
         (let ((cell (grid-ref grid x y)))