Refine bomb logic

This commit is the first of a series introducing hidden logic through
non-obvious commits. I'm mentioning it in the commit messages in the hopes no
one reads these so I can sneak it in without leaving no record at all ;)
This commit is contained in:
Juliana Sims 2024-05-26 00:33:38 -04:00
parent d725310239
commit f87e7f3f76
No known key found for this signature in database
GPG key ID: 2A00BD4B0090029E
2 changed files with 34 additions and 35 deletions

View file

@ -44,13 +44,6 @@
('electron-head 'electron-tail) ('electron-head 'electron-tail)
('electron-tail 'copper))) ('electron-tail 'copper)))
(define (grid-electrified? neighbor-grid)
(let lp ((i 0))
(cond
((= i (vector-length neighbor-grid)) #f)
((eq? (vector-ref neighbor-grid i) 'electron-head) #t)
(else (lp (+ i 1))))))
(define (electron-head-count neighbor-grid) (define (electron-head-count neighbor-grid)
(define (check state) (define (check state)
(match state (match state
@ -372,47 +365,48 @@
(define alive? (spawn ^cell #t)) (define alive? (spawn ^cell #t))
(define countdown (spawn ^cell -1)) (define countdown (spawn ^cell -1))
(define pushed? (spawn ^cell)) (define pushed? (spawn ^cell))
(define* (light-fuse #:optional (time 2)) (define (light-fuse)
($ countdown time)) ($ countdown 2))
(match-lambda* (match-lambda*
(('type) 'bomb) (('type) 'bomb)
(('position) ($ position)) (('position) ($ position))
(('tick grid-info) (('tick grid-info)
($ pushed? #f) ($ pushed? #f)
(when (> ($ countdown) 0) (when (> ($ countdown) 0)
($ countdown (- ($ countdown) 1))) (let ((cd (1- ($ countdown))))
(when (= ($ countdown) 0) ($ countdown cd)
($ alive? #f) (when (= cd 0)
(match ($ position) ($ alive? #f)
(#(x y z) (match ($ position)
(do ((ix (- x 1) (+ ix 1))) (#(x y z)
((> ix (+ x 1))) (do ((ix (- x 1) (+ ix 1)))
(do ((iy (- y 1) (+ iy 1))) ((> ix (+ x 1)))
((> iy (+ y 1))) (do ((iy (- y 1) (+ iy 1)))
(unless (and (= ix x) (= iy y)) ((> iy (+ y 1)))
(let ((obj (match ($ grid-info 'occupants ix iy) (unless (and (= ix x) (= iy y))
(() #f) (let ((obj (match ($ grid-info 'occupants ix iy)
((obj . rest) obj)))) (() #f)
(when obj ((obj . rest) obj))))
(match ($ obj 'type) (when obj
((or 'bomb 'brick) (match ($ obj 'type)
($ obj 'explode)) ((or 'bomb 'brick)
('player ($ obj 'explode))
($ obj 'explode) ('player
($ grid-info 'append-event `(player-death ,ix ,iy))) ($ obj 'explode)
(_ #f))))))) ($ grid-info 'append-event `(player-death ,ix ,iy)))
($ grid-info 'append-event `(explosion ,x ,y)))))) (_ #f)))))))
($ grid-info 'append-event `(explosion ,x ,y))))))))
(('post-tick grid-info) #f) (('post-tick grid-info) #f)
(('enter obj grid-info) #f) (('enter obj grid-info) #f)
(('exit obj grid-info) #f) (('exit obj grid-info) #f)
(('wire-state grid-info from from-x from-y) #f) (('wire-state grid-info from from-x from-y) #f)
(('update-wire-state grid-info neighbor-grid) (('update-wire-state grid-info neighbor-grid)
(when (and (< ($ countdown) 0) (when (and (< ($ countdown) 0)
(grid-electrified? neighbor-grid)) (> (electron-head-count neighbor-grid) 0))
(light-fuse))) (light-fuse)))
(('alive?) ($ alive?)) (('alive?) ($ alive?))
(('describe) `(bomb ,($ position) ,($ countdown))) (('describe) `(bomb ,($ position) ,($ countdown)))
(('explode) (light-fuse 1)) (('explode) (light-fuse))
(('activate grid-info) #f) (('activate grid-info) #f)
(('deactivate grid-info) #f) (('deactivate grid-info) #f)
(('collide other offset grid-info) (('collide other offset grid-info)
@ -437,7 +431,7 @@
;; A gem that has already been collected previously will still appear ;; A gem that has already been collected previously will still appear
;; in the level but it will be drawn differently. ;; in the level but it will be drawn differently.
(define (^gem bcom x y previously-collected?) (define* (^gem bcom x y previously-collected? #:optional test?)
(define position (vector x y 1)) (define position (vector x y 1))
(define picked-up? (spawn ^cell)) (define picked-up? (spawn ^cell))
(match-lambda* (match-lambda*

View file

@ -67,7 +67,12 @@
(when (< x width) (when (< x width)
(let* ((i (+ (* y width) x)) (let* ((i (+ (* y width) x))
(pos (vec2 (* x tile-width) (* y tile-height))) (pos (vec2 (* x tile-width) (* y tile-height)))
(id (bytevector-u16-native-ref background (* i 2))) (id (case (bytevector-u16-native-ref background (* i 2))
((120) 81)
((121) 82)
((122) 85)
((123) 105)
(else => (lambda (v) v))))
(tile (make-level-tile pos id))) (tile (make-level-tile pos id)))
(vector-set! background* i tile)) (vector-set! background* i tile))
(x-loop (1+ x)))) (x-loop (1+ x))))