SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Player always ticks first.

Browse source
This commit is contained in:
David Thompson 2024-05-22 13:36:00 -04:00
parent 6b9edbca25
commit f1afd9e177
1 changed files with 33 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
modules/game/actors.scm
View file

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