Player always ticks first.

This commit is contained in:
David Thompson 2024-05-22 13:36:00 -04:00
parent 6b9edbca25
commit f1afd9e177

View file

@ -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)
;; Tick each object and check for collisions.
(iter-objects
(lambda (obj)
(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))))))
(collide obj desired-pos prev-pos)))))
(define (tick)
(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.
(iter-objects (lambda (obj) ($ obj 'post-tick grid-info))))
($ 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)))