Add gems and the start of floor switches.

This commit is contained in:
David Thompson 2024-05-21 14:10:57 -04:00
parent 5fb33112d8
commit ba7b9ea9d8
5 changed files with 142 additions and 36 deletions

View file

@ -552,6 +552,8 @@ the default ORIENTATION value of 'orthogonal' is supported."
(define obj:block:copper 5)
(define obj:block:crate 6)
(define obj:clock-emitter 7)
(define obj:floor-switch 8)
(define obj:gem 9)
(define (compile-environment-layer tile-map layer-name)
(let ((tw (tile-map-tile-width tile-map))
@ -583,7 +585,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
(append-map (lambda (obj)
(let* ((type (map-object-type obj))
(properties (map-object-properties obj))
(r (pk 'obj type (map-object-shape obj)))
(r (map-object-shape obj))
(x (/ (rect-x r) tw))
(y (/ (rect-y r) th)))
(match type
@ -593,6 +595,8 @@ the default ORIENTATION value of 'orthogonal' is supported."
("crate" (list x y obj:block:crate))
("copper" (list x y obj:block:copper))
(kind (error "unsupported block kind" kind))))
('floor-switch (list x y obj:floor-switch))
('gem (list x y obj:gem))
(_ (error "unsupported object type" type)))))
(object-layer-objects layer))))
@ -611,12 +615,13 @@ the default ORIENTATION value of 'orthogonal' is supported."
`((define-module ,module-name
#:use-module (game level)
#:export (,proc-name))
(define (,proc-name)
(define (,proc-name spawn-gem?)
(make-level ,(tile-map-width tile-map)
,(tile-map-height tile-map)
,(compile-tile-layer tile-map "background")
,(u8-list->bytevector
(append
(compile-environment-layer tile-map "background")
(compile-object-layer tile-map "objects")))))))))
(compile-object-layer tile-map "objects")))
spawn-gem?))))))
(_ (error "file name expected")))