(define-module (game level) #:use-module (game actors) #:use-module (goblins core) #:use-module (hoot bytevectors) #:use-module (ice-9 match) #:use-module (srfi srfi-9) #:export (make-level level? level-background level-actor level-player)) ;; Client-side rendering info coupled with level actor that contains ;; game state. (define-record-type (%make-level background actor player) level? (background level-background) (actor level-actor) (player level-player)) (define (make-level width height background objects spawn-gem?) (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))) (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)) (8 (let ((target-x (bytevector-u8-ref objects (+ i 3))) (target-y (bytevector-u8-ref objects (+ i 4)))) (spawn ^floor-switch x y target-x target-y))) (9 (and spawn-gem? (spawn ^gem x y))) (10 (spawn ^gate x y)) (id (error "invalid level object" id)))) (i* (+ i (match id (8 5) ; floor-switch (_ 3))))) (when obj ($ level* 'add-object obj)) (if (= id 3) ; player-spawn (lp i* obj) (lp i* player))) (%make-level background level* player)))))