Spawn ghost gems where gems used to be.

This commit is contained in:
David Thompson 2024-05-22 18:34:29 -04:00
parent 2dc354229d
commit 111eb33429
6 changed files with 37 additions and 6 deletions

View file

@ -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,

View file

@ -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)

View file

@ -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)

View file

@ -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)

View file

@ -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)))

View file

@ -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")))