From f1afd9e177367ec2e6273d9e75b0fb830d2d9ade Mon Sep 17 00:00:00 2001 From: David Thompson 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)))