(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)) (11 (spawn ^and-gate x y)) (12 (let ((target-x (bytevector-u8-ref objects (+ i 3))) (target-y (bytevector-u8-ref objects (+ i 4)))) (spawn ^electric-switch x y target-x target-y))) (13 (spawn ^xor-gate x y)) (id (error "invalid level object" id)))) (i* (+ i (match id ;; floor-switch or electric-switch ((or 8 12) 5) (_ 3))))) (when obj ($ level* 'add-object obj)) (if (= id 3) ; player-spawn (lp i* obj) (lp i* player))) (%make-level background level* player)))))