Add first draft of tutorial levels.

This commit is contained in:
David Thompson 2024-05-24 12:09:26 -04:00
parent 0b5c86aa21
commit 23f034a868
10 changed files with 514 additions and 24 deletions

View file

@ -125,16 +125,18 @@
(#(x y z)
(match offset
(#(dx dy)
(let ((x (+ x dx))
(y (+ y dy)))
(let ((occupant-types
(map (lambda (obj) ($ obj 'type))
($ grid-info 'occupants x y))))
(match occupant-types
((or () ('switch))
($ pushed? #t)
($ position (vector x y z)))
(_ #f))))))))))
(match ($ grid-info 'dimensions)
(#(w h)
(let ((x (modulo (+ x dx) w))
(y (modulo (+ y dy) h)))
(let ((occupant-types
(map (lambda (obj) ($ obj 'type))
($ grid-info 'occupants x y))))
(match occupant-types
((or () ('switch))
($ pushed? #t)
($ position (vector x y z)))
(_ #f))))))))))))
(('pushed?) ($ pushed?))))
(define (^clock-emitter bcom x y interval)
@ -325,7 +327,7 @@
(('exit obj grid-info) #f)
(('wire-state grid-info from from-x from-y) #f)
(('update-wire-state grid-info neighbor-grid) #f)
(('alive?) (not ($ picked-up?)))
(('alive?) (pk 'gem-alive? (not ($ picked-up?))))
(('describe) `(gem ,position))
(('collide other offset grid-info)
(when (eq? ($ other 'type) 'player)
@ -634,9 +636,12 @@
(match ($ position)
(#(x y z)
(match ($ velocity)
(#(0 0) (values))
(#(dx dy)
($ position (vector (+ x dx) (+ y dy) z))
($ velocity #(0 0)))))))
(match ($ grid-info 'dimensions)
(#(w h)
($ position (vector (modulo (+ x dx) w) (modulo (+ y dy) h) z))
($ velocity #(0 0)))))))))
(('post-tick grid-info)
;; Search for objects that were fine to step onto last turn, but
;; have become deadly this turn.
@ -746,12 +751,10 @@
;; Read-only access to query the grid, but can write events.
(define (^grid-info bcom)
(match-lambda*
(('occupied? x y)
(not (null? ($ (grid-ref grid x y)))))
(('occupants x y)
($ (grid-ref grid x y)))
(('append-event event)
($ event-log 'append event))))
(('dimensions) (vector width height))
(('occupied? x y) (not (null? ($ (grid-ref/wrap grid x y)))))
(('occupants x y) ($ (grid-ref/wrap grid x y)))
(('append-event event) ($ event-log 'append event))))
(define grid-info (spawn ^grid-info))
(define (delq item lst)