From 111eb3342910bdef15dd59f984d79bab4f5c21b5 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 22 May 2024 18:34:29 -0400 Subject: [PATCH] Spawn ghost gems where gems used to be. --- game.js | 1 + game.scm | 11 +++++++++-- modules/dom/canvas.scm | 4 ++++ modules/game/actors.scm | 17 +++++++++++++++++ modules/game/level.scm | 6 ++++-- scripts/compile-map.scm | 4 ++-- 6 files changed, 37 insertions(+), 6 deletions(-) diff --git a/game.js b/game.js index e063178..74a2be9 100644 --- a/game.js +++ b/game.js @@ -58,6 +58,7 @@ window.addEventListener("load", async () => { }, canvas: { getContext: (elem, type) => elem.getContext(type), + setGlobalAlpha: (ctx, alpha) => ctx.globalAlpha = alpha, setFillColor: (ctx, color) => ctx.fillStyle = color, setFont: (ctx, font) => ctx.font = font, setTextAlign: (ctx, align) => ctx.textAlign = align, diff --git a/game.scm b/game.scm index 29de759..444a9bc 100644 --- a/game.scm +++ b/game.scm @@ -150,7 +150,7 @@ (<= az bz)))))))))) (define (collected-gem? idx) - (not (memq idx *gems*))) + (memq idx *gems*)) (define (load-level! idx) (set! *state* 'play) @@ -288,6 +288,11 @@ (define (draw-gem pos) (draw-tile context tileset 28 (vec2-x pos) (vec2-y pos))) +(define (draw-ghost-gem pos) + (set-global-alpha! context 0.5) + (draw-tile context tileset 49 (vec2-x pos) (vec2-y pos)) + (set-global-alpha! context 1.0)) + (define (draw-gate pos open?) (draw-tile context tileset (if open? 46 45) (vec2-x pos) (vec2-y pos))) @@ -315,6 +320,7 @@ (('clock-emitter pos) #t) ; drawn via background (('floor-switch pos on?) (draw-floor-switch pos on?)) (('gem pos) (draw-gem pos)) + (('ghost-gem pos) (draw-ghost-gem pos)) (('gate pos open?) (draw-gate pos open?)) (('and-gate pos state) (draw-logic-gate pos state 42)) (('or-gate pos state) (draw-logic-gate pos state 43)) @@ -344,7 +350,8 @@ (fill-text context "OUCH... x_x" (/ game-width 2.0) (/ game-height 2.0))))) (define (draw-win) - (set-fill-color! context "#x000000") + (set-fill-color! context "#000000") + (set-text-align! context "left") (fill-text context "OMG YOU DID IT WOW CONGRATS" 32.0 120.0)) (define (draw prev-time) diff --git a/modules/dom/canvas.scm b/modules/dom/canvas.scm index 57bd7fc..7bb03fc 100644 --- a/modules/dom/canvas.scm +++ b/modules/dom/canvas.scm @@ -23,6 +23,7 @@ #:use-module (scheme base) #:use-module (hoot ffi) #:export (get-context + set-global-alpha! set-fill-color! set-font! set-text-align! @@ -40,6 +41,9 @@ (ref extern) (ref string) -> (ref extern)) ;; CanvasRenderingContext2D +(define-foreign set-global-alpha! + "canvas" "setGlobalAlpha" + (ref extern) f64 -> none) (define-foreign set-fill-color! "canvas" "setFillColor" (ref extern) (ref string) -> none) diff --git a/modules/game/actors.scm b/modules/game/actors.scm index ea1f488..07d22e5 100644 --- a/modules/game/actors.scm +++ b/modules/game/actors.scm @@ -9,6 +9,7 @@ ^floor-switch ^gate ^gem + ^ghost-gem ^and-gate ^xor-gate ^or-gate @@ -268,6 +269,21 @@ (when (eq? ($ other 'type) 'player) ($ picked-up? #t))))) +(define (^ghost-gem bcom x y) + (define position (vector x y 1)) + (match-lambda* + (('type) 'ghost-gem) + (('position) position) + (('tick grid-info) #f) + (('post-tick grid-info) #f) + (('enter obj grid-info) #f) + (('exit obj grid-info) #f) + (('wire-state grid-info) #f) + (('update-wire-state grid-info) #f) + (('alive?) #t) + (('describe) `(ghost-gem ,position)) + (('collide other offset grid-info) #f))) + (define (^gate bcom x y) (define position (vector x y 1)) (define open? (spawn ^cell)) @@ -461,6 +477,7 @@ ($ event '(bump))))) ('switch ($ event '(switch))) ('gem ($ event '(gem))) + ('ghost-gem #t) ('gate (unless ($ other 'open?) (reverse-move) diff --git a/modules/game/level.scm b/modules/game/level.scm index f5cfef0..846c36e 100644 --- a/modules/game/level.scm +++ b/modules/game/level.scm @@ -37,7 +37,7 @@ (actor level-actor) (player level-player)) -(define (make-level width height background objects spawn-gem?) +(define (make-level width height background objects collected-gem?) (let ((level* (spawn ^level width height)) (background* (make-vector (* width height)))) ;; Unpack background tile data. @@ -70,7 +70,9 @@ (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))) + (9 (if collected-gem? + (spawn ^ghost-gem x y) + (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))) diff --git a/scripts/compile-map.scm b/scripts/compile-map.scm index b9c0c4e..e670d28 100644 --- a/scripts/compile-map.scm +++ b/scripts/compile-map.scm @@ -635,7 +635,7 @@ the default ORIENTATION value of 'orthogonal' is supported." `((define-module ,module-name #:use-module (game level) #:export (,proc-name)) - (define (,proc-name spawn-gem?) + (define (,proc-name collected-gem?) (make-level ,(tile-map-width tile-map) ,(tile-map-height tile-map) ,(compile-tile-layer tile-map "background") @@ -643,5 +643,5 @@ the default ORIENTATION value of 'orthogonal' is supported." (append (compile-environment-layer tile-map "background") (compile-object-layer tile-map "objects"))) - spawn-gem?)))))) + collected-gem?)))))) (_ (error "file name expected")))