Merge branch 'menu' into 'main'

Have menu open and close with Space

See merge request spritely/cirkoban!1
This commit is contained in:
Amy Grinn 2024-12-31 19:18:13 +00:00
commit 25e27df8c1
3 changed files with 265 additions and 42 deletions

View file

@ -67,6 +67,7 @@ window.addEventListener("load", async () => {
getContext: (elem, type) => elem.getContext(type), getContext: (elem, type) => elem.getContext(type),
setGlobalAlpha: (ctx, alpha) => ctx.globalAlpha = alpha, setGlobalAlpha: (ctx, alpha) => ctx.globalAlpha = alpha,
setFillColor: (ctx, color) => ctx.fillStyle = color, setFillColor: (ctx, color) => ctx.fillStyle = color,
setStrokeColor: (ctx, color) => ctx.strokeStyle = color,
setFont: (ctx, font) => ctx.font = font, setFont: (ctx, font) => ctx.font = font,
setTextAlign: (ctx, align) => ctx.textAlign = align, setTextAlign: (ctx, align) => ctx.textAlign = align,
clearRect: (ctx, x, y, w, h) => ctx.clearRect(x, y, w, h), clearRect: (ctx, x, y, w, h) => ctx.clearRect(x, y, w, h),

301
game.scm
View file

@ -61,7 +61,8 @@
(local-storage) (local-storage)
(math) (math)
(math rect) (math rect)
(math vector)) (math vector)
(scheme base))
(define game-width 320.0) (define game-width 320.0)
(define game-height 240.0) (define game-height 240.0)
@ -105,7 +106,20 @@
(define audio:bg-music (load-music "cirkoban")) (define audio:bg-music (load-music "cirkoban"))
;; Game state ;; Game state
(define *state* #f) (define *state* '(initial))
(define (push-game-state! state)
(set! *state* (cons state *state*)))
(define (pop-game-state!)
(when (pair? *state*)
(set! *state* (cdr *state*))))
(define (replace-game-state! state)
(match *state*
((_ . rest)
(set! *state* (cons state rest)))))
(define (current-game-state)
(match *state*
((state . _) state)))
(define *actormap* (make-whactormap)) (define *actormap* (make-whactormap))
(define (call-with-goblins thunk) (define (call-with-goblins thunk)
@ -132,6 +146,8 @@
load-catboss-2 load-catboss-2
load-catboss-3)) load-catboss-3))
(define *level-idx* #f) (define *level-idx* #f)
;; Last level for restoring after visiting credits via the menu
(define *level-last* #f)
(define *gems* #f) (define *gems* #f)
(define *level* #f) (define *level* #f)
;; Latest representation of all actors in level ;; Latest representation of all actors in level
@ -201,8 +217,8 @@
(define (collected-gem? idx) (define (collected-gem? idx)
(memq idx *gems*)) (memq idx *gems*))
(define (load-level! idx) (define (set-level! idx)
(set! *state* 'play) (replace-game-state! 'play)
(set! *actormap* (make-whactormap)) (set! *actormap* (make-whactormap))
(clear-snapshots!) (clear-snapshots!)
(with-goblins (with-goblins
@ -210,7 +226,7 @@
(update-objects!))) (update-objects!)))
(define (load-credits!) (define (load-credits!)
(set! *state* 'win) (replace-game-state! 'credits)
(set! *actormap* (make-whactormap)) (set! *actormap* (make-whactormap))
(set-vec2-y! *credits-scroll* 0.0) (set-vec2-y! *credits-scroll* 0.0)
(clear-snapshots!) (clear-snapshots!)
@ -218,8 +234,7 @@
(set! *level* (load-credits #f)) (set! *level* (load-credits #f))
(update-objects!))) (update-objects!)))
(define (next-level!) (define (load-level! idx)
(let ((idx (+ *level-idx* 1)))
;; TODO: Maybe show a little achievement popup when all gems ;; TODO: Maybe show a little achievement popup when all gems
;; are collected? ;; are collected?
(when (with-goblins ($ (level-actor *level*) 'gem-collected?)) (when (with-goblins ($ (level-actor *level*) 'gem-collected?))
@ -228,17 +243,17 @@
(begin (begin
(run-script (run-script
(lambda () (lambda ()
(set! *state* 'interstitial) (replace-game-state! 'interstitial)
(yield (yield
(lambda (k) (lambda (k)
(show-effect! (make-fade-out+in-effect 1.0 k)))) (show-effect! (make-fade-out+in-effect 1.0 k))))
(set! *level-idx* idx) (set! *level-idx* idx)
(save-game!) (save-game!)
(load-level! idx)))) (set-level! idx))))
(begin (begin
(run-script (run-script
(lambda () (lambda ()
(set! *state* 'interstitial) (replace-game-state! 'interstitial)
(yield (yield
(lambda (k) (lambda (k)
(show-effect! (make-fade-out+in-effect 2.0 k)))) (show-effect! (make-fade-out+in-effect 2.0 k))))
@ -248,7 +263,10 @@
;; text from showing up when resetting the game, set ;; text from showing up when resetting the game, set
;; level idx to non-zero during the credits. ;; level idx to non-zero during the credits.
(set! *level-idx* -1) (set! *level-idx* -1)
(load-credits!))))))) (load-credits!))))))
(define (next-level!)
(load-level! (+ *level-idx* 1)))
;; Auto-save/load to local storage. ;; Auto-save/load to local storage.
(define (save-game!) (define (save-game!)
@ -266,18 +284,127 @@
((idx gems) ((idx gems)
(set! *level-idx* idx) (set! *level-idx* idx)
(set! *gems* gems) (set! *gems* gems)
(load-level! *level-idx*) (set-level! *level-idx*)
(media-play audio:bg-music))))) (media-play audio:bg-music)))))
;; Menu types
(define-record-type <menu>
(make-menu name items)
menu?
(name menu-name)
(items menu-items))
;; Menu state
(define-record-type <menu-state>
(make-menu-state current index page history)
menu-state?
(current menu-state-current set-menu-state-current!)
(index menu-state-index set-menu-state-index!)
(page menu-state-page set-menu-state-page!)
(history menu-state-history set-menu-state-history!))
(define (menu-action:submenu menu)
(lambda ()
(push-menu-history!)
(set-menu! menu)
(set-menu-index! -1)))
(define (menu-action:load-level level)
(lambda ()
(hide-menu!)
(load-level! level)))
(define (menu-action:credits)
(hide-menu!)
(set! *level-last* *level-idx*)
(load-level! (vector-length levels)))
;; Menu constants
(define center (vec2 (* 10.0 tile-width) (* 7.0 tile-height)))
(define menu:max-items 10)
(define menu:level-select
(let ((items (make-vector (vector-length levels))))
(do ((i 0 (1+ i)))
((= i (vector-length levels)))
(vector-set! items i (cons (string-append "Level " (number->string i))
(menu-action:load-level i))))
(make-menu "Select Level" items)))
(define menu:main
(make-menu "Menu" (vector (cons "Select Level"
(menu-action:submenu menu:level-select))
(cons "Credits" menu-action:credits))))
;; -1 for the index means 'Back' will be indicated first
(define *menu* (make-menu-state menu:main -1 0 '()))
(define (current-menu)
(menu-state-current *menu*))
(define (current-menu-index)
(menu-state-index *menu*))
(define (current-menu-page)
(menu-state-page *menu*))
(define (current-menu-history)
(menu-state-history *menu*))
(define (set-menu! menu)
(set-menu-state-current! *menu* menu))
(define (set-menu-index! index)
(set-menu-state-index! *menu* index))
(define (set-menu-page! page)
(set-menu-state-page! *menu* page))
(define (set-menu-history! history)
(set-menu-state-history! *menu* history))
;; Menu commands
(define* (show-menu! #:optional (menu menu:main))
(push-game-state! 'menu)
(set-menu! menu)
(set-menu-index! -1)
(set-menu-page! 0)
(set-menu-history! '()))
(define (hide-menu!)
(pop-game-state!))
(define (menu-up!)
(set-menu-index! (max -1 (1- (current-menu-index))))
(when (and (> (current-menu-page) 0)
(= (current-menu-index) (- (* (current-menu-page) menu:max-items) (current-menu-page) 1)))
(set-menu-page! (1- (current-menu-page)))))
(define (menu-down!)
(set-menu-index! (min (1- (vector-length (menu-items (current-menu)))) (1+ (current-menu-index))))
(when (= (current-menu-index) (- (* (1+ (current-menu-page)) menu:max-items) (current-menu-page)))
(set-menu-page! (1+ (current-menu-page)))))
(define (push-menu-history!)
(set-menu-history! (cons (cons (current-menu)
(current-menu-index))
(current-menu-history))))
(define (pop-menu-history!)
(match (current-menu-history)
(() (hide-menu!))
(((prev . index) . rest)
(set-menu! prev)
(set-menu-index! index)
(set-menu-history! rest))))
(define (menu-select!)
(if (= (current-menu-index) -1) ;; back button pressed
(pop-menu-history!)
((cdr (vector-ref (menu-items (current-menu)) (current-menu-index))))))
(define (reset-game!) (define (reset-game!)
(run-script (run-script
(lambda () (lambda ()
(set! *state* 'interstitial) (replace-game-state! 'interstitial)
(yield (yield
(lambda (k) (lambda (k)
(show-effect! (make-fade-out+in-effect 2.0 k)))) (show-effect! (make-fade-out+in-effect 2.0 k))))
(set! *level-idx* 0) (set! *level-idx* 0)
(load-level! 0)))) (set-level! 0))))
(define (emit-pickup-particles x y) (define (emit-pickup-particles x y)
(run-script (run-script
@ -607,6 +734,94 @@
(id (level-tile-id tile))) (id (level-tile-id tile)))
(draw-tile context tileset id (vec2-x pos) (vec2-y pos)))))) (draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
(define (draw-menu)
;; Height (in tiles) will be 1 for the menu title + the y padding
;; + 1 for the back button if on the first page or ellipses otherwise
;; + num menu items + 1 for ellipses if num items is too big
;; + the y padding again
(let* ((padding-y 1)
(text-offset-y (* 0.75 tile-height))
(width 8.0)
(num-items (vector-length (menu-items (current-menu))))
(height (+ 2 ;; Menu title + back/ellipses
(* 2 padding-y) ;; Padding
(if (> num-items menu:max-items)
(1+ menu:max-items) ;; bottom ellipses
num-items)))
(y-start (- (vec2-y center) (* tile-height
(floor (/ height 2)))))
(x-start (- (vec2-x center) (* tile-width
(floor (/ width 2))))))
;; Draw menu background
(let ((w (* tile-width width))
(h (* tile-height height)))
(set-fill-color! context "#000")
(fill-rect context x-start y-start w h)
(set-stroke-color! context "blue")
(stroke-rect context x-start y-start w h))
;; Draw menu text
(set-font! context "normal 16px monogram")
(set-fill-color! context "#fff")
(let* (;; The first menu item is at index 0. The 'Back' or ellipses are
;; directly above the first menu item at index -1. The menu title
;; is above the 'Back' button and separated by the padding-y
(r-start (- -2 padding-y))
;; end of text
(r-end (- (+ r-start height) padding-y))
;; r will not take into account which page you are on
(r-page-offset (- (* (current-menu-page) menu:max-items) (current-menu-page)))
(x-gutter (+ tile-width x-start))
(x-text (+ tile-width x-gutter)))
(do ((r r-start (1+ r)) (y y-start (+ tile-height y)))
((or (>= r r-end) (>= (+ r r-page-offset) num-items)))
(let ((y-text (+ y text-offset-y))
(r-page (+ r r-page-offset)))
;; Draw menu title
(when (= r r-start)
(set-text-align! context "center")
(fill-text context (menu-name (current-menu))
(vec2-x center) y-text))
(set-text-align! context "left")
;; indicator
(when (= (+ r r-page-offset) (current-menu-index))
(fill-text context "▸" x-gutter y-text))
;; Menu items
(when (>= r -1)
(fill-text
context
(cond
((= r-page -1) "Back")
((or (= r -1) (and (= r (1- r-end))
(< r-page (1- num-items))))
"...")
(else
(car (vector-ref (menu-items (current-menu))
r-page))))
x-text y-text)))))))
(define (draw-controls)
(let ((cx1 (/ game-width 4.0))
(cx2 (* game-width 0.75))
(baseline (/ game-height 2.0)))
(set-fill-color! context "#ffffff")
(set-text-align! context "center")
(set-font! context "normal 16px monogram")
(fill-text context "keyboard:"
cx1 (- baseline 32.0))
(fill-text context "arrows -> move"
cx1 (- baseline 16.0))
(fill-text context "Z -> undo"
cx1 baseline)
(fill-text context "touchscreen:"
cx2 (- baseline 32.0))
(fill-text context "dpad -> move"
cx2 (- baseline 16.0))
(fill-text context "A -> undo"
cx2 baseline)))
(define (draw-level) (define (draw-level)
(draw-background) (draw-background)
(for-each draw-object *objects*) (for-each draw-object *objects*)
@ -620,7 +835,9 @@
(set-font! context "normal 32px monogram") (set-font! context "normal 32px monogram")
(set-fill-color! context "#ffffff") (set-fill-color! context "#ffffff")
(set-text-align! context "center") (set-text-align! context "center")
(fill-text context "OUCH... x_x" (/ game-width 2.0) (/ game-height 2.0))))) (fill-text context "OUCH... x_x" (/ game-width 2.0) (/ game-height 2.0))))
(when (= *level-idx* 0)
(draw-controls)))
(define (draw-interstitial) (define (draw-interstitial)
(draw-level)) (draw-level))
@ -675,7 +892,7 @@
(define credits-line-spacing 16.0) (define credits-line-spacing 16.0)
(define max-credits-scroll (define max-credits-scroll
(+ game-height (* (- (vector-length credits) 9) credits-line-spacing))) (+ game-height (* (- (vector-length credits) 9) credits-line-spacing)))
(define (draw-win) (define (draw-credits)
(draw-level) (draw-level)
(set-fill-color! context "#ffffff") (set-fill-color! context "#ffffff")
(set-text-align! context "center") (set-text-align! context "center")
@ -726,30 +943,13 @@
(scale! context *canvas-scale* *canvas-scale*) (scale! context *canvas-scale* *canvas-scale*)
(draw-current-effect 'pre) (draw-current-effect 'pre)
(match *state* (match (current-game-state)
((or 'play 'interstitial) ((or 'play 'interstitial)
(draw-level))
('menu
(draw-level) (draw-level)
;; Display input mappings on the title screen/first level. (draw-menu))
(when (= *level-idx* 0) ('credits (draw-credits)))
(let ((cx1 (/ game-width 4.0))
(cx2 (* game-width 0.75))
(baseline (/ game-height 2.0)))
(set-fill-color! context "#ffffff")
(set-text-align! context "center")
(set-font! context "normal 16px monogram")
(fill-text context "keyboard:"
cx1 (- baseline 32.0))
(fill-text context "arrows -> move"
cx1 (- baseline 16.0))
(fill-text context "Z -> undo"
cx1 baseline)
(fill-text context "touchscreen:"
cx2 (- baseline 32.0))
(fill-text context "dpad -> move"
cx2 (- baseline 16.0))
(fill-text context "A -> undo"
cx2 baseline))))
('win (draw-win)))
(draw-current-effect 'post) (draw-current-effect 'post)
(request-animation-frame draw-callback))) (request-animation-frame draw-callback)))
(define draw-callback (procedure->external draw)) (define draw-callback (procedure->external draw))
@ -761,6 +961,7 @@
(define key:up "ArrowUp") (define key:up "ArrowUp")
(define key:confirm "Enter") (define key:confirm "Enter")
(define key:undo "KeyZ") (define key:undo "KeyZ")
(define key:menu "Space")
(define (on-key-down event) (define (on-key-down event)
(let ((key (keyboard-event-code event))) (let ((key (keyboard-event-code event)))
@ -776,7 +977,9 @@
((string=? key key:undo) ((string=? key key:undo)
(on-input-down 'undo)) (on-input-down 'undo))
((string=? key key:confirm) ((string=? key key:confirm)
(on-input-down 'confirm))))) (on-input-down 'confirm))
((string=? key key:menu)
(on-input-down 'menu)))))
(define *gamepad* #f) (define *gamepad* #f)
(define *button:left* #f) (define *button:left* #f)
@ -837,7 +1040,7 @@
(on-input-down 'undo)))))))) (on-input-down 'undo))))))))
(define (on-input-down input) (define (on-input-down input)
(match *state* (match (current-game-state)
('play ('play
(match input (match input
('left (move-player 'left)) ('left (move-player 'left))
@ -849,9 +1052,23 @@
(with-goblins (update-objects!))) (with-goblins (update-objects!)))
;; REMOVE BEFORE RELEASE!!!! ;; REMOVE BEFORE RELEASE!!!!
;; ('confirm (next-level!)) ;; ('confirm (next-level!))
)) ('menu (show-menu!))
(_ #f)))
('menu
(match input
('up (menu-up!))
('down (menu-down!))
('confirm (menu-select!))
('menu (hide-menu!))
(_ #f)))
;; Pressing any bound input resets the game. ;; Pressing any bound input resets the game.
('win (reset-game!)))) ;; If traveling to the credits via the menu, go back to '*level-last*'
('credits
(cond
(*level-last*
(load-level! *level-last*)
(set! *level-last* #f))
(else (reset-game!))))))
;; Canvas and event loop setup ;; Canvas and event loop setup
(define canvas (get-element-by-id "canvas")) (define canvas (get-element-by-id "canvas"))

View file

@ -25,10 +25,12 @@
#:export (get-context #:export (get-context
set-global-alpha! set-global-alpha!
set-fill-color! set-fill-color!
set-stroke-color!
set-font! set-font!
set-text-align! set-text-align!
clear-rect clear-rect
fill-rect fill-rect
stroke-rect
fill-text fill-text
draw-image draw-image
restore! restore!
@ -51,6 +53,9 @@
(define-foreign set-fill-color! (define-foreign set-fill-color!
"canvas" "setFillColor" "canvas" "setFillColor"
(ref extern) (ref string) -> none) (ref extern) (ref string) -> none)
(define-foreign set-stroke-color!
"canvas" "setStrokeColor"
(ref extern) (ref string) -> none)
(define-foreign set-font! (define-foreign set-font!
"canvas" "setFont" "canvas" "setFont"
(ref extern) (ref string) -> none) (ref extern) (ref string) -> none)