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

Big actor refactor; use local storage for auto-save.

Browse source
This commit is contained in:
David Thompson 2024-05-20 22:12:35 -04:00
parent ce0c002e8b
commit 816d9d149d
7 changed files with 321 additions and 202 deletions
Download patch file Download diff file Expand all files Collapse all files

50
modules/game/level.scm
View file

@ -7,37 +7,39 @@
#:export (make-level
level?
level-background
level-actor))
level-actor
level-player))
;; Client-side rendering info coupled with level actor that contains
;; game state.
(define-record-type <level>
(%make-level background actor)
(%make-level background actor player)
level?
(background level-background)
(actor level-actor))
(actor level-actor)
(player level-player))
(define (make-level width height background objects)
(let ((level* (spawn ^level width height)))
;; Parsed packed object data and spawn objects.
(let ((len (bytevector-length objects)))
(let lp ((i 0))
(when (< i len)
(let ((x (bytevector-u8-ref objects i))
(let ((level* (spawn ^level width height))
(len (bytevector-length objects)))
;; Parsed packed object data and spawn objects, making special
;; note of the player.
(let lp ((i 0) (player #f))
(if (< i len)
(let* ((x (bytevector-u8-ref objects i))
(y (bytevector-u8-ref objects (+ i 1)))
(id (bytevector-u8-ref objects (+ i 2))))
(id (bytevector-u8-ref objects (+ i 2)))
(obj (match id
(1 (spawn ^wall x y 'brick))
(2 (spawn ^wall x y 'copper))
(3 (spawn ^player x y))
(4 (spawn ^exit x y))
(5 (spawn ^block x y 'copper))
(6 (spawn ^block x y 'crate))
(7 (spawn ^clock-emitter x y 4))
(id (error "invalid level object" id)))))
($ level* 'add-object obj)
(if (= id 3) ; player-spawn
(begin
(pk 'spawn-player x y)
($ level* 'warp-player x y))
(let ((obj (match id
(1 (spawn ^wall 'brick))
(2 (spawn ^wall 'copper))
(4 (spawn ^exit))
(5 (spawn ^block 'copper))
(6 (spawn ^block 'crate))
(7 (spawn ^clock-emitter 4))
(id (error "invalid level object" id)))))
($ level* 'set-object x y obj))))
(lp (+ i 3)))))
(%make-level background level*)))
(lp (+ i 3) obj)
(lp (+ i 3) player)))
(%make-level background level* player)))))