From 60b998758df3864b79ad2097e71761fee1e8810b Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Wed, 11 Dec 2024 10:13:20 -0500 Subject: [PATCH 01/20] Have menu open and close with Space --- game.scm | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/game.scm b/game.scm index 1fbaba7..1e3f817 100644 --- a/game.scm +++ b/game.scm @@ -107,6 +107,10 @@ ;; Game state (define *state* #f) +;; Menu state +(define *menu* #f) +(define *menu:index* 0) + (define *actormap* (make-whactormap)) (define (call-with-goblins thunk) (actormap-churn-run! *actormap* thunk)) @@ -269,6 +273,13 @@ (load-level! *level-idx*) (media-play audio:bg-music))))) +(define (toggle-menu!) + (cond + (*menu* (set! *menu* #f)) + (else + (set! *menu* menu:main) + (set! *menu:index* 0)))) + (define (reset-game!) (run-script (lambda () @@ -607,6 +618,22 @@ (id (level-tile-id tile))) (draw-tile context tileset id (vec2-x pos) (vec2-y pos)))))) +(define menu:main #(("Select Level" . menu:level-select) + ("Credits" . menu:credits))) + +;; (define menu:level-select +;; (vector-map +;; (lambda (i val) +;; (cons (string-append "Level " (string->number i)) i)) +;; levels)) + +(define (draw-menu) + (do ((x (* 7 tile-width) (+ tile-width x))) + ((> x (* 13 tile-width))) + (do ((y 0 (+ tile-height y))) + ((> y (* 15 tile-height))) + (draw-tile context tileset 23 x y)))) + (define (draw-level) (draw-background) (for-each draw-object *objects*) @@ -750,6 +777,8 @@ (fill-text context "A -> undo" cx2 baseline)))) ('win (draw-win))) + (when *menu* + (draw-menu)) (draw-current-effect 'post) (request-animation-frame draw-callback))) (define draw-callback (procedure->external draw)) @@ -761,6 +790,7 @@ (define key:up "ArrowUp") (define key:confirm "Enter") (define key:undo "KeyZ") +(define key:menu "Space") (define (on-key-down event) (let ((key (keyboard-event-code event))) @@ -776,7 +806,9 @@ ((string=? key key:undo) (on-input-down 'undo)) ((string=? key key:confirm) - (on-input-down 'confirm))))) + (on-input-down 'confirm)) + ((string=? key key:menu) + (on-input-down 'menu))))) (define *gamepad* #f) (define *button:left* #f) @@ -849,7 +881,7 @@ (with-goblins (update-objects!))) ;; REMOVE BEFORE RELEASE!!!! ;; ('confirm (next-level!)) - )) + ('menu (toggle-menu!)))) ;; Pressing any bound input resets the game. ('win (reset-game!)))) From 7bf1d2014706db939a5e23cc3f0a8c8ef708a8fc Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Wed, 11 Dec 2024 17:44:00 -0500 Subject: [PATCH 02/20] Drawing menu to the screen with text Also allows user to step up and down the menu. No action is performed when confirming a menu item yet. Can't handle menus larger than the screen yet. --- game.scm | 108 +++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 77 insertions(+), 31 deletions(-) diff --git a/game.scm b/game.scm index 1e3f817..cef76c3 100644 --- a/game.scm +++ b/game.scm @@ -273,12 +273,21 @@ (load-level! *level-idx*) (media-play audio:bg-music))))) -(define (toggle-menu!) - (cond - (*menu* (set! *menu* #f)) - (else - (set! *menu* menu:main) - (set! *menu:index* 0)))) +(define (show-menu!) + (set! *menu* menu:main) + (set! *menu:index* 0)) + +(define (menu-up!) + (set! *menu:index* (max -1 (1- *menu:index*)))) + +(define (menu-down!) + (set! *menu:index* (min (1- (vector-length *menu*)) (1+ *menu:index*)))) + +(define (hide-menu!) + (set! *menu* #f)) + +(define (menu-select!) + "TODO select the current index of the menu.") (define (reset-game!) (run-script @@ -621,18 +630,47 @@ (define menu:main #(("Select Level" . menu:level-select) ("Credits" . menu:credits))) -;; (define menu:level-select -;; (vector-map -;; (lambda (i val) -;; (cons (string-append "Level " (string->number i)) i)) -;; levels)) +(define menu:level-select + (let ((menu (make-vector (vector-length levels)))) + (do ((i 0 (1+ i))) + ((= i (vector-length levels))) + (vector-set! menu i (cons (string-append "Level " (number->string i)) + (vector-ref levels i)))) + menu)) + +(define center (vec2 (* 10.0 tile-width) (* 7.0 tile-height))) (define (draw-menu) - (do ((x (* 7 tile-width) (+ tile-width x))) - ((> x (* 13 tile-width))) - (do ((y 0 (+ tile-height y))) - ((> y (* 15 tile-height))) - (draw-tile context tileset 23 x y)))) + (set-text-align! context "center") + (set-font! context "normal 16px monogram") + (set-fill-color! context "#fff") + ;; Height (in tiles) will be 1 for the menu title + the y padding + ;; + 1 for the back button + num menu items + the y padding again + (let* ((padding-y 1) + (text-offset-y (* 0.75 tile-height)) + (width 6) + (height (min level-height (+ 2 (* 2 padding-y) (vector-length *menu*)))) + (r-start (- -2 padding-y))) + (let row ((r r-start) + (y (- (vec2-y center) (* tile-height (floor (/ height 2)))))) + ;; Draw menu background + (do ((c (- (floor (/ width 2))) (1+ c))) + ((= c (floor (/ width 2)))) + (let ((x (+ (vec2-x center) (* tile-width c)))) + (draw-tile context tileset 109 x y))) + ;; Draw menu text + (cond + ((= r r-start) + (fill-text context "Menu" (vec2-x center) (+ y text-offset-y))) + ((and (>= r -1) (< r (vector-length *menu*))) + (let* ((item (or (and (= r -1) "Back") + (car (vector-ref *menu* r)))) + (text (string-append (or (and (= r *menu:index*) "▸ ") " ") + item))) + (fill-text context text (vec2-x center) (+ y text-offset-y))))) + ;; Draw next row + (if (< (1+ r) (+ r-start height)) + (row (1+ r) (+ y tile-height)))))) (define (draw-level) (draw-background) @@ -869,21 +907,29 @@ (on-input-down 'undo)))))))) (define (on-input-down input) - (match *state* - ('play - (match input - ('left (move-player 'left)) - ('right (move-player 'right)) - ('up (move-player 'up)) - ('down (move-player 'down)) - ('undo - (rollback-snapshot!) - (with-goblins (update-objects!))) - ;; REMOVE BEFORE RELEASE!!!! - ;; ('confirm (next-level!)) - ('menu (toggle-menu!)))) - ;; Pressing any bound input resets the game. - ('win (reset-game!)))) + (cond + (*menu* + (match input + ('up (menu-up!)) + ('down (menu-down!)) + ('confirm (menu-select!)) + ('menu (hide-menu!)))) + (else + (match *state* + ('play + (match input + ('left (move-player 'left)) + ('right (move-player 'right)) + ('up (move-player 'up)) + ('down (move-player 'down)) + ('undo + (rollback-snapshot!) + (with-goblins (update-objects!))) + ;; REMOVE BEFORE RELEASE!!!! + ('confirm (next-level!)) + ('menu (show-menu!)))) + ;; Pressing any bound input resets the game. + ('win (reset-game!)))))) ;; Canvas and event loop setup (define canvas (get-element-by-id "canvas")) From d6506a6e6d122be57f5b8950d82fed46b0d54b16 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Thu, 12 Dec 2024 09:18:02 -0500 Subject: [PATCH 03/20] Enter and leave sub-menus Created record types for menus and menu items --- game.scm | 69 ++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 54 insertions(+), 15 deletions(-) diff --git a/game.scm b/game.scm index cef76c3..00b7100 100644 --- a/game.scm +++ b/game.scm @@ -61,7 +61,8 @@ (local-storage) (math) (math rect) - (math vector)) + (math vector) + (scheme base)) (define game-width 320.0) (define game-height 240.0) @@ -110,6 +111,20 @@ ;; Menu state (define *menu* #f) (define *menu:index* 0) +(define *menu:history* '()) + +(define-record-type + (make-menu name items) + menu? + (name menu-name) + (items menu-items)) + +(define-record-type + (make-menu-item name type payload) + menu-item? + (name menu-item-name) + (type menu-item-type) + (payload menu-item-payload)) (define *actormap* (make-whactormap)) (define (call-with-goblins thunk) @@ -275,19 +290,40 @@ (define (show-menu!) (set! *menu* menu:main) - (set! *menu:index* 0)) + (set! *menu:index* -1) + (set! *menu:history* '())) (define (menu-up!) (set! *menu:index* (max -1 (1- *menu:index*)))) (define (menu-down!) - (set! *menu:index* (min (1- (vector-length *menu*)) (1+ *menu:index*)))) + (set! *menu:index* (min (1- (vector-length (menu-items *menu*))) (1+ *menu:index*)))) (define (hide-menu!) (set! *menu* #f)) (define (menu-select!) - "TODO select the current index of the menu.") + (cond + ;; Back button + ((= *menu:index* -1) + (cond + ((null? *menu:history*) + (hide-menu!)) + (else + (let ((last (car *menu:history*))) + (set! *menu* (car last)) + (set! *menu:index* (cdr last))) + (set! *menu:history* (cdr *menu:history*))))) + (else + (let* ((item (vector-ref (menu-items *menu*) *menu:index*)) + (type (menu-item-type item)) + (payload (menu-item-payload item))) + (match type + ;; Sub menu + ('menu + (set! *menu:history* (cons (cons *menu* *menu:index*) *menu:history*)) + (set! *menu* payload) + (set! *menu:index* -1))))))) (define (reset-game!) (run-script @@ -627,16 +663,19 @@ (id (level-tile-id tile))) (draw-tile context tileset id (vec2-x pos) (vec2-y pos)))))) -(define menu:main #(("Select Level" . menu:level-select) - ("Credits" . menu:credits))) - (define menu:level-select - (let ((menu (make-vector (vector-length levels)))) + (let ((items (make-vector (vector-length levels)))) (do ((i 0 (1+ i))) ((= i (vector-length levels))) - (vector-set! menu i (cons (string-append "Level " (number->string i)) - (vector-ref levels i)))) - menu)) + (vector-set! items i (make-menu-item (string-append "Level " (number->string i)) + 'level + (vector-ref levels i)))) + (make-menu "Select Level" items))) + +(define menu:main + (make-menu "Menu" (vector (make-menu-item "Select Level" + 'menu menu:level-select) + (make-menu-item "Credits" 'credits #f)))) (define center (vec2 (* 10.0 tile-width) (* 7.0 tile-height))) @@ -649,7 +688,7 @@ (let* ((padding-y 1) (text-offset-y (* 0.75 tile-height)) (width 6) - (height (min level-height (+ 2 (* 2 padding-y) (vector-length *menu*)))) + (height (min level-height (+ 2 (* 2 padding-y) (vector-length (menu-items *menu*))))) (r-start (- -2 padding-y))) (let row ((r r-start) (y (- (vec2-y center) (* tile-height (floor (/ height 2)))))) @@ -661,10 +700,10 @@ ;; Draw menu text (cond ((= r r-start) - (fill-text context "Menu" (vec2-x center) (+ y text-offset-y))) - ((and (>= r -1) (< r (vector-length *menu*))) + (fill-text context (menu-name *menu*) (vec2-x center) (+ y text-offset-y))) + ((and (>= r -1) (< r (vector-length (menu-items *menu*)))) (let* ((item (or (and (= r -1) "Back") - (car (vector-ref *menu* r)))) + (menu-item-name (vector-ref (menu-items *menu*) r)))) (text (string-append (or (and (= r *menu:index*) "▸ ") " ") item))) (fill-text context text (vec2-x center) (+ y text-offset-y))))) From dbca0ba6cf258c47a5038e09caa32e25652f67c4 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Thu, 12 Dec 2024 12:47:54 -0500 Subject: [PATCH 04/20] Added paging to menu --- game.scm | 138 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 82 insertions(+), 56 deletions(-) diff --git a/game.scm b/game.scm index 00b7100..b742345 100644 --- a/game.scm +++ b/game.scm @@ -108,24 +108,6 @@ ;; Game state (define *state* #f) -;; Menu state -(define *menu* #f) -(define *menu:index* 0) -(define *menu:history* '()) - -(define-record-type - (make-menu name items) - menu? - (name menu-name) - (items menu-items)) - -(define-record-type - (make-menu-item name type payload) - menu-item? - (name menu-item-name) - (type menu-item-type) - (payload menu-item-payload)) - (define *actormap* (make-whactormap)) (define (call-with-goblins thunk) (actormap-churn-run! *actormap* thunk)) @@ -288,16 +270,58 @@ (load-level! *level-idx*) (media-play audio:bg-music))))) +;; Menu types +(define-record-type + (make-menu name items) + menu? + (name menu-name) + (items menu-items)) + +(define-record-type + (make-menu-item name type payload) + menu-item? + (name menu-item-name) + (type menu-item-type) + (payload menu-item-payload)) + +;; Menu constants +(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 (make-menu-item (string-append "Level " (number->string i)) + 'level + (vector-ref levels i)))) + (make-menu "Select Level" items))) +(define menu:main + (make-menu "Menu" (vector (make-menu-item "Select Level" + 'menu menu:level-select) + (make-menu-item "Credits" 'credits #f)))) + +;; Menu state +(define *menu* #f) +(define *menu:index* -1) +(define *menu:page* 0) +(define *menu:history* '()) + +;; Menu commands (define (show-menu!) (set! *menu* menu:main) (set! *menu:index* -1) - (set! *menu:history* '())) + (set! *menu:history* '()) + (set! *menu:page* 0)) (define (menu-up!) - (set! *menu:index* (max -1 (1- *menu:index*)))) + (set! *menu:index* (max -1 (1- *menu:index*))) + (if (and (> *menu:page* 0) + (= *menu:index* (- (* *menu:page* menu:max-items) *menu:page* 1))) + (set! *menu:page* (1- *menu:page*)))) (define (menu-down!) - (set! *menu:index* (min (1- (vector-length (menu-items *menu*))) (1+ *menu:index*)))) + (set! *menu:index* (min (1- (vector-length (menu-items *menu*))) (1+ *menu:index*))) + (if (= *menu:index* (- (* (1+ *menu:page*) menu:max-items) *menu:page*)) + (set! *menu:page* (1+ *menu:page*)))) (define (hide-menu!) (set! *menu* #f)) @@ -663,53 +687,55 @@ (id (level-tile-id tile))) (draw-tile context tileset id (vec2-x pos) (vec2-y pos)))))) -(define menu:level-select - (let ((items (make-vector (vector-length levels)))) - (do ((i 0 (1+ i))) - ((= i (vector-length levels))) - (vector-set! items i (make-menu-item (string-append "Level " (number->string i)) - 'level - (vector-ref levels i)))) - (make-menu "Select Level" items))) - -(define menu:main - (make-menu "Menu" (vector (make-menu-item "Select Level" - 'menu menu:level-select) - (make-menu-item "Credits" 'credits #f)))) (define center (vec2 (* 10.0 tile-width) (* 7.0 tile-height))) (define (draw-menu) - (set-text-align! context "center") - (set-font! context "normal 16px monogram") - (set-fill-color! context "#fff") ;; Height (in tiles) will be 1 for the menu title + the y padding - ;; + 1 for the back button + num menu items + the y padding again + ;; + 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 6) - (height (min level-height (+ 2 (* 2 padding-y) (vector-length (menu-items *menu*))))) - (r-start (- -2 padding-y))) + (width 8) + (num-items (vector-length (menu-items *menu*))) + (height (+ 2 ;; Menu title + back/ellipses + (* 2 padding-y) ;; Padding + (cond ;; Num items + ellispses + ((> num-items menu:max-items) + (1+ menu:max-items)) + (else num-items)))) + (r-start (- -2 padding-y)) + (r-end (- (+ r-start height) padding-y))) (let row ((r r-start) (y (- (vec2-y center) (* tile-height (floor (/ height 2)))))) ;; Draw menu background - (do ((c (- (floor (/ width 2))) (1+ c))) - ((= c (floor (/ width 2)))) - (let ((x (+ (vec2-x center) (* tile-width c)))) - (draw-tile context tileset 109 x y))) + (if (= r r-start) + (let* ((x1 (- (vec2-x center) (* tile-width (floor (/ width 2))))) + (w (* tile-width width)) + (h (* tile-height height))) + (set-fill-color! context "#000") + (fill-rect context x1 y w h))) ;; Draw menu text - (cond - ((= r r-start) - (fill-text context (menu-name *menu*) (vec2-x center) (+ y text-offset-y))) - ((and (>= r -1) (< r (vector-length (menu-items *menu*)))) - (let* ((item (or (and (= r -1) "Back") - (menu-item-name (vector-ref (menu-items *menu*) r)))) - (text (string-append (or (and (= r *menu:index*) "▸ ") " ") - item))) - (fill-text context text (vec2-x center) (+ y text-offset-y))))) + (set-text-align! context "center") + (set-font! context "normal 16px monogram") + (set-fill-color! context "#fff") + (let ((r-index (- (+ r (* *menu:page* menu:max-items)) *menu:page*))) + (cond + ((= r r-start) + (fill-text context (menu-name *menu*) (vec2-x center) (+ y text-offset-y))) + ((and (>= r -1) (< r-index num-items) (< r r-end)) + (let* ((item (or (and (= r -1) (or (and (= *menu:page* 0) "Back") + "...")) + (and (= r (1- r-end)) (< r-index (1- num-items)) "...") + (menu-item-name (vector-ref (menu-items *menu*) r-index)))) + (text (string-append (or (and (= r-index *menu:index*) "▸ ") " ") + item))) + (fill-text context text (vec2-x center) (+ y text-offset-y)))))) ;; Draw next row - (if (< (1+ r) (+ r-start height)) - (row (1+ r) (+ y tile-height)))))) + (set! r (1+ r)) + (if (< r (+ r-start height)) + (row r (+ y tile-height)))))) (define (draw-level) (draw-background) From c393ab50b391f17626747aaa1b04b51115d158a2 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Thu, 12 Dec 2024 13:28:48 -0500 Subject: [PATCH 05/20] Doing the actions when selecting menu items --- game.scm | 40 +++++++++++++++++++++++++++------------- 1 file changed, 27 insertions(+), 13 deletions(-) diff --git a/game.scm b/game.scm index b742345..f81e0a4 100644 --- a/game.scm +++ b/game.scm @@ -133,6 +133,8 @@ load-catboss-2 load-catboss-3)) (define *level-idx* #f) +;; Last level for restoring after visiting credits via the menu +(define *level-last* #f) (define *gems* #f) (define *level* #f) ;; Latest representation of all actors in level @@ -202,7 +204,7 @@ (define (collected-gem? idx) (memq idx *gems*)) -(define (load-level! idx) +(define (set-level! idx) (set! *state* 'play) (set! *actormap* (make-whactormap)) (clear-snapshots!) @@ -219,8 +221,7 @@ (set! *level* (load-credits #f)) (update-objects!))) -(define (next-level!) - (let ((idx (+ *level-idx* 1))) +(define (load-level! idx) ;; TODO: Maybe show a little achievement popup when all gems ;; are collected? (when (with-goblins ($ (level-actor *level*) 'gem-collected?)) @@ -235,7 +236,7 @@ (show-effect! (make-fade-out+in-effect 1.0 k)))) (set! *level-idx* idx) (save-game!) - (load-level! idx)))) + (set-level! idx)))) (begin (run-script (lambda () @@ -249,7 +250,10 @@ ;; text from showing up when resetting the game, set ;; level idx to non-zero during the credits. (set! *level-idx* -1) - (load-credits!))))))) + (load-credits!)))))) + +(define (next-level!) + (load-level! (+ *level-idx* 1))) ;; Auto-save/load to local storage. (define (save-game!) @@ -267,7 +271,7 @@ ((idx gems) (set! *level-idx* idx) (set! *gems* gems) - (load-level! *level-idx*) + (set-level! *level-idx*) (media-play audio:bg-music))))) ;; Menu types @@ -291,8 +295,8 @@ (do ((i 0 (1+ i))) ((= i (vector-length levels))) (vector-set! items i (make-menu-item (string-append "Level " (number->string i)) - 'level - (vector-ref levels i)))) + 'level i))) + (make-menu "Select Level" items))) (define menu:main (make-menu "Menu" (vector (make-menu-item "Select Level" @@ -347,7 +351,14 @@ ('menu (set! *menu:history* (cons (cons *menu* *menu:index*) *menu:history*)) (set! *menu* payload) - (set! *menu:index* -1))))))) + (set! *menu:index* -1)) + ('level + (hide-menu!) + (load-level! payload)) + ('credits + (hide-menu!) + (set! *level-last* *level-idx*) + (load-level! (vector-length levels)))))))) (define (reset-game!) (run-script @@ -357,7 +368,7 @@ (lambda (k) (show-effect! (make-fade-out+in-effect 2.0 k)))) (set! *level-idx* 0) - (load-level! 0)))) + (set-level! 0)))) (define (emit-pickup-particles x y) (run-script @@ -880,8 +891,7 @@ (fill-text context "A -> undo" cx2 baseline)))) ('win (draw-win))) - (when *menu* - (draw-menu)) + (if *menu* (draw-menu)) (draw-current-effect 'post) (request-animation-frame draw-callback))) (define draw-callback (procedure->external draw)) @@ -994,7 +1004,11 @@ ('confirm (next-level!)) ('menu (show-menu!)))) ;; Pressing any bound input resets the game. - ('win (reset-game!)))))) + ('win (cond + (*level-last* + (load-level! *level-last*) + (set! *level-last* #f)) + (else (reset-game!)))))))) ;; Canvas and event loop setup (define canvas (get-element-by-id "canvas")) From 20948a59552eafd5aed2757306c8b3993ea8e295 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Thu, 12 Dec 2024 13:31:46 -0500 Subject: [PATCH 06/20] Finalizing menu --- game.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/game.scm b/game.scm index f81e0a4..0347e58 100644 --- a/game.scm +++ b/game.scm @@ -1001,7 +1001,7 @@ (rollback-snapshot!) (with-goblins (update-objects!))) ;; REMOVE BEFORE RELEASE!!!! - ('confirm (next-level!)) + ;; ('confirm (next-level!)) ('menu (show-menu!)))) ;; Pressing any bound input resets the game. ('win (cond From 06a982747e2d3437c1bfd53bbcb8770a5e4fad8a Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Fri, 13 Dec 2024 15:31:19 -0500 Subject: [PATCH 07/20] Combining menu state into a single record --- game.scm | 226 +++++++++++++++++++++++------------------ modules/dom/canvas.scm | 4 + 2 files changed, 130 insertions(+), 100 deletions(-) diff --git a/game.scm b/game.scm index 0347e58..1a583e0 100644 --- a/game.scm +++ b/game.scm @@ -275,20 +275,54 @@ (media-play audio:bg-music))))) ;; Menu types + (define-record-type (make-menu name items) menu? (name menu-name) (items menu-items)) +;; Menu state + +(define-record-type + (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* (make-menu-state #f -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)) + (define-record-type - (make-menu-item name type payload) + (_make-menu-item name type payload) menu-item? (name menu-item-name) (type menu-item-type) (payload menu-item-payload)) +(define* (make-menu-item name type #:optional payload) + (_make-menu-item name type payload)) + ;; 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)))) @@ -301,64 +335,60 @@ (define menu:main (make-menu "Menu" (vector (make-menu-item "Select Level" 'menu menu:level-select) - (make-menu-item "Credits" 'credits #f)))) - -;; Menu state -(define *menu* #f) -(define *menu:index* -1) -(define *menu:page* 0) -(define *menu:history* '()) + (make-menu-item "Credits" 'credits)))) ;; Menu commands -(define (show-menu!) - (set! *menu* menu:main) - (set! *menu:index* -1) - (set! *menu:history* '()) - (set! *menu:page* 0)) - -(define (menu-up!) - (set! *menu:index* (max -1 (1- *menu:index*))) - (if (and (> *menu:page* 0) - (= *menu:index* (- (* *menu:page* menu:max-items) *menu:page* 1))) - (set! *menu:page* (1- *menu:page*)))) - -(define (menu-down!) - (set! *menu:index* (min (1- (vector-length (menu-items *menu*))) (1+ *menu:index*))) - (if (= *menu:index* (- (* (1+ *menu:page*) menu:max-items) *menu:page*)) - (set! *menu:page* (1+ *menu:page*)))) +(define* (show-menu! #:optional menu) + (set-menu! (or menu menu:main)) + (set-menu-index! -1) + (set-menu-page! 0) + (set-menu-history! '())) (define (hide-menu!) - (set! *menu* #f)) + (set-menu! #f)) + +(define (menu-up!) + (set-menu-index! (max -1 (1- (current-menu-index)))) + (if (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)))) + (if (= (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!) - (cond - ;; Back button - ((= *menu:index* -1) - (cond - ((null? *menu:history*) - (hide-menu!)) - (else - (let ((last (car *menu:history*))) - (set! *menu* (car last)) - (set! *menu:index* (cdr last))) - (set! *menu:history* (cdr *menu:history*))))) - (else - (let* ((item (vector-ref (menu-items *menu*) *menu:index*)) - (type (menu-item-type item)) - (payload (menu-item-payload item))) - (match type - ;; Sub menu - ('menu - (set! *menu:history* (cons (cons *menu* *menu:index*) *menu:history*)) - (set! *menu* payload) - (set! *menu:index* -1)) - ('level - (hide-menu!) - (load-level! payload)) - ('credits - (hide-menu!) - (set! *level-last* *level-idx*) - (load-level! (vector-length levels)))))))) + (if (= (current-menu-index) -1) + (pop-menu-history!) + (let* ((item (vector-ref (menu-items (current-menu)) (current-menu-index))) + (type (menu-item-type item)) + (payload (menu-item-payload item))) + (match type + ('menu + (push-menu-history!) + (set-menu! payload) + (set-menu-index! -1)) + ('level + (hide-menu!) + (load-level! payload)) + ('credits + (hide-menu!) + (set! *level-last* *level-idx*) + (load-level! (vector-length levels))))))) (define (reset-game!) (run-script @@ -699,8 +729,6 @@ (draw-tile context tileset id (vec2-x pos) (vec2-y pos)))))) -(define center (vec2 (* 10.0 tile-width) (* 7.0 tile-height))) - (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 @@ -709,13 +737,12 @@ (let* ((padding-y 1) (text-offset-y (* 0.75 tile-height)) (width 8) - (num-items (vector-length (menu-items *menu*))) + (num-items (vector-length (menu-items (current-menu)))) (height (+ 2 ;; Menu title + back/ellipses (* 2 padding-y) ;; Padding - (cond ;; Num items + ellispses - ((> num-items menu:max-items) - (1+ menu:max-items)) - (else num-items)))) + (if (> num-items menu:max-items) + (1+ menu:max-items) + num-items))) (r-start (- -2 padding-y)) (r-end (- (+ r-start height) padding-y))) (let row ((r r-start) @@ -731,18 +758,19 @@ (set-text-align! context "center") (set-font! context "normal 16px monogram") (set-fill-color! context "#fff") - (let ((r-index (- (+ r (* *menu:page* menu:max-items)) *menu:page*))) - (cond - ((= r r-start) - (fill-text context (menu-name *menu*) (vec2-x center) (+ y text-offset-y))) - ((and (>= r -1) (< r-index num-items) (< r r-end)) - (let* ((item (or (and (= r -1) (or (and (= *menu:page* 0) "Back") - "...")) - (and (= r (1- r-end)) (< r-index (1- num-items)) "...") - (menu-item-name (vector-ref (menu-items *menu*) r-index)))) - (text (string-append (or (and (= r-index *menu:index*) "▸ ") " ") - item))) - (fill-text context text (vec2-x center) (+ y text-offset-y)))))) + (let ((r-index (- (+ r (* (current-menu-page) menu:max-items)) (current-menu-page)))) + (if (= r r-start) + (fill-text context (menu-name (current-menu)) (vec2-x center) (+ y text-offset-y)) + (if (and (>= r -1) (< r-index num-items) (< r r-end)) + (let* ((item (cond + ((= r -1) + (if (= (current-menu-page) 0) "Back" "...")) + ((and (= r (1- r-end)) (< r-index (1- num-items))) + "...") + (else + (menu-item-name (vector-ref (menu-items (current-menu)) r-index))))) + (text (string-append (if (= r-index (current-menu-index)) "▸ " " ") item))) + (fill-text context text (vec2-x center) (+ y text-offset-y)))))) ;; Draw next row (set! r (1+ r)) (if (< r (+ r-start height)) @@ -891,7 +919,7 @@ (fill-text context "A -> undo" cx2 baseline)))) ('win (draw-win))) - (if *menu* (draw-menu)) + (if (current-menu) (draw-menu)) (draw-current-effect 'post) (request-animation-frame draw-callback))) (define draw-callback (procedure->external draw)) @@ -982,33 +1010,31 @@ (on-input-down 'undo)))))))) (define (on-input-down input) - (cond - (*menu* - (match input - ('up (menu-up!)) - ('down (menu-down!)) - ('confirm (menu-select!)) - ('menu (hide-menu!)))) - (else - (match *state* - ('play - (match input - ('left (move-player 'left)) - ('right (move-player 'right)) - ('up (move-player 'up)) - ('down (move-player 'down)) - ('undo - (rollback-snapshot!) - (with-goblins (update-objects!))) - ;; REMOVE BEFORE RELEASE!!!! - ;; ('confirm (next-level!)) - ('menu (show-menu!)))) - ;; Pressing any bound input resets the game. - ('win (cond - (*level-last* - (load-level! *level-last*) - (set! *level-last* #f)) - (else (reset-game!)))))))) + (if (current-menu) + (match input + ('up (menu-up!)) + ('down (menu-down!)) + ('confirm (menu-select!)) + ('menu (hide-menu!))) + (match *state* + ('play + (match input + ('left (move-player 'left)) + ('right (move-player 'right)) + ('up (move-player 'up)) + ('down (move-player 'down)) + ('undo + (rollback-snapshot!) + (with-goblins (update-objects!))) + ;; REMOVE BEFORE RELEASE!!!! + ;; ('confirm (next-level!)) + ('menu (show-menu!)))) + ;; Pressing any bound input resets the game. + ('win (if *level-last* + (begin + (load-level! *level-last*) + (set! *level-last* #f)) + (reset-game!)))))) ;; Canvas and event loop setup (define canvas (get-element-by-id "canvas")) diff --git a/modules/dom/canvas.scm b/modules/dom/canvas.scm index 08bdf07..ec00c14 100644 --- a/modules/dom/canvas.scm +++ b/modules/dom/canvas.scm @@ -29,6 +29,7 @@ set-text-align! clear-rect fill-rect + ;; stroke fill-text draw-image restore! @@ -72,6 +73,9 @@ (define-foreign draw-image "canvas" "drawImage" (ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none) +;; (define-foreign stroke +;; "canvas" "stroke" +;; (ref extern) -> none) (define-foreign restore! "canvas" "restore" (ref extern) -> none) From 6aed092c24468a0f5847684c1d42b5e25e9d29cd Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Tue, 17 Dec 2024 12:33:36 -0500 Subject: [PATCH 08/20] Changed stroke color of menu --- game.js | 1 + game.scm | 6 ++++-- modules/dom/canvas.scm | 6 +++++- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/game.js b/game.js index 49f2da6..47780a6 100644 --- a/game.js +++ b/game.js @@ -67,6 +67,7 @@ window.addEventListener("load", async () => { getContext: (elem, type) => elem.getContext(type), setGlobalAlpha: (ctx, alpha) => ctx.globalAlpha = alpha, setFillColor: (ctx, color) => ctx.fillStyle = color, + setStrokeColor: (ctx, color) => ctx.strokeStyle = color, setFont: (ctx, font) => ctx.font = font, setTextAlign: (ctx, align) => ctx.textAlign = align, clearRect: (ctx, x, y, w, h) => ctx.clearRect(x, y, w, h), diff --git a/game.scm b/game.scm index 1a583e0..73e6f9d 100644 --- a/game.scm +++ b/game.scm @@ -749,11 +749,13 @@ (y (- (vec2-y center) (* tile-height (floor (/ height 2)))))) ;; Draw menu background (if (= r r-start) - (let* ((x1 (- (vec2-x center) (* tile-width (floor (/ width 2))))) + (let* ((x (- (vec2-x center) (* tile-width (floor (/ width 2))))) (w (* tile-width width)) (h (* tile-height height))) (set-fill-color! context "#000") - (fill-rect context x1 y w h))) + (fill-rect context x y w h) + (set-stroke-color! context "blue") + (stroke-rect context x y w h))) ;; Draw menu text (set-text-align! context "center") (set-font! context "normal 16px monogram") diff --git a/modules/dom/canvas.scm b/modules/dom/canvas.scm index ec00c14..46dc8fa 100644 --- a/modules/dom/canvas.scm +++ b/modules/dom/canvas.scm @@ -25,11 +25,12 @@ #:export (get-context set-global-alpha! set-fill-color! + set-stroke-color! set-font! set-text-align! clear-rect fill-rect - ;; stroke + stroke-rect fill-text draw-image restore! @@ -52,6 +53,9 @@ (define-foreign set-fill-color! "canvas" "setFillColor" (ref extern) (ref string) -> none) +(define-foreign set-stroke-color! + "canvas" "setStrokeColor" + (ref extern) (ref string) -> none) (define-foreign set-font! "canvas" "setFont" (ref extern) (ref string) -> none) From 0e5fc5a73b84ad863d8f361afac46c56c15e37db Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Tue, 17 Dec 2024 12:39:19 -0500 Subject: [PATCH 09/20] Optimizing conditionals --- game.scm | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/game.scm b/game.scm index 73e6f9d..60756e6 100644 --- a/game.scm +++ b/game.scm @@ -748,14 +748,14 @@ (let row ((r r-start) (y (- (vec2-y center) (* tile-height (floor (/ height 2)))))) ;; Draw menu background - (if (= r r-start) - (let* ((x (- (vec2-x center) (* tile-width (floor (/ width 2))))) - (w (* tile-width width)) - (h (* tile-height height))) - (set-fill-color! context "#000") - (fill-rect context x y w h) - (set-stroke-color! context "blue") - (stroke-rect context x y w h))) + (when (= r r-start) + (let* ((x (- (vec2-x center) (* tile-width (floor (/ width 2))))) + (w (* tile-width width)) + (h (* tile-height height))) + (set-fill-color! context "#000") + (fill-rect context x y w h) + (set-stroke-color! context "blue") + (stroke-rect context x y w h))) ;; Draw menu text (set-text-align! context "center") (set-font! context "normal 16px monogram") @@ -764,13 +764,12 @@ (if (= r r-start) (fill-text context (menu-name (current-menu)) (vec2-x center) (+ y text-offset-y)) (if (and (>= r -1) (< r-index num-items) (< r r-end)) - (let* ((item (cond - ((= r -1) - (if (= (current-menu-page) 0) "Back" "...")) - ((and (= r (1- r-end)) (< r-index (1- num-items))) - "...") - (else - (menu-item-name (vector-ref (menu-items (current-menu)) r-index))))) + (let* ((item (if (= r -1) + (if (= (current-menu-page) 0) + "Back" "...") + (if (and (= r (1- r-end)) (< r-index (1- num-items))) + "..." + (menu-item-name (vector-ref (menu-items (current-menu)) r-index))))) (text (string-append (if (= r-index (current-menu-index)) "▸ " " ") item))) (fill-text context text (vec2-x center) (+ y text-offset-y)))))) ;; Draw next row From a42d5c56560b1d4f48c3cf2797653c722285d604 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Tue, 17 Dec 2024 13:59:47 -0500 Subject: [PATCH 10/20] Created game state history --- game.scm | 166 +++++++++++++++++++++++++++++-------------------------- 1 file changed, 89 insertions(+), 77 deletions(-) diff --git a/game.scm b/game.scm index 60756e6..a15d09b 100644 --- a/game.scm +++ b/game.scm @@ -106,7 +106,16 @@ (define audio:bg-music (load-music "cirkoban")) ;; Game state -(define *state* #f) +(define *state* (list #f)) + +(define (push-game-state! state) + (set! *state* (cons state *state*))) +(define (pop-game-state!) + (set! *state* (cdr *state*))) + +(define (current-game-state) (car *state*)) + + (define *actormap* (make-whactormap)) (define (call-with-goblins thunk) @@ -205,7 +214,7 @@ (memq idx *gems*)) (define (set-level! idx) - (set! *state* 'play) + (push-game-state! 'play) (set! *actormap* (make-whactormap)) (clear-snapshots!) (with-goblins @@ -213,7 +222,7 @@ (update-objects!))) (define (load-credits!) - (set! *state* 'win) + (push-game-state! 'win) (set! *actormap* (make-whactormap)) (set-vec2-y! *credits-scroll* 0.0) (clear-snapshots!) @@ -230,7 +239,7 @@ (begin (run-script (lambda () - (set! *state* 'interstitial) + (push-game-state! 'interstitial) (yield (lambda (k) (show-effect! (make-fade-out+in-effect 1.0 k)))) @@ -240,7 +249,7 @@ (begin (run-script (lambda () - (set! *state* 'interstitial) + (push-game-state! 'interstitial) (yield (lambda (k) (show-effect! (make-fade-out+in-effect 2.0 k)))) @@ -292,25 +301,6 @@ (page menu-state-page set-menu-state-page!) (history menu-state-history set-menu-state-history!)) -(define *menu* (make-menu-state #f -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)) - (define-record-type (_make-menu-item name type payload) menu-item? @@ -329,23 +319,42 @@ (do ((i 0 (1+ i))) ((= i (vector-length levels))) (vector-set! items i (make-menu-item (string-append "Level " (number->string i)) - 'level i))) - + 'level i))) (make-menu "Select Level" items))) (define menu:main (make-menu "Menu" (vector (make-menu-item "Select Level" 'menu menu:level-select) (make-menu-item "Credits" 'credits)))) +(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) + (push-game-state! 'menu) (set-menu! (or menu menu:main)) (set-menu-index! -1) (set-menu-page! 0) (set-menu-history! '())) (define (hide-menu!) - (set-menu! #f)) + (pop-game-state!)) (define (menu-up!) (set-menu-index! (max -1 (1- (current-menu-index)))) @@ -393,7 +402,7 @@ (define (reset-game!) (run-script (lambda () - (set! *state* 'interstitial) + (push-game-state! 'interstitial) (yield (lambda (k) (show-effect! (make-fade-out+in-effect 2.0 k)))) @@ -896,31 +905,33 @@ (scale! context *canvas-scale* *canvas-scale*) (draw-current-effect 'pre) - (match *state* - ((or 'play 'interstitial) - (draw-level) - ;; Display input mappings on the title screen/first level. - (when (= *level-idx* 0) - (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))) - (if (current-menu) (draw-menu)) + (let ((state (current-game-state))) + (match state + ((or 'menu 'play 'interstitial) + (draw-level) + ;; Display input mappings on the title screen/first level. + (when (= *level-idx* 0) + (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))) + (when (eq? 'menu state) + (draw-menu))) + ('win (draw-win)))) (draw-current-effect 'post) (request-animation-frame draw-callback))) (define draw-callback (procedure->external draw)) @@ -1011,31 +1022,32 @@ (on-input-down 'undo)))))))) (define (on-input-down input) - (if (current-menu) - (match input - ('up (menu-up!)) - ('down (menu-down!)) - ('confirm (menu-select!)) - ('menu (hide-menu!))) - (match *state* - ('play - (match input - ('left (move-player 'left)) - ('right (move-player 'right)) - ('up (move-player 'up)) - ('down (move-player 'down)) - ('undo - (rollback-snapshot!) - (with-goblins (update-objects!))) + (match (current-game-state) + ('play + (match input + ('left (move-player 'left)) + ('right (move-player 'right)) + ('up (move-player 'up)) + ('down (move-player 'down)) + ('undo + (rollback-snapshot!) + (with-goblins (update-objects!))) ;; REMOVE BEFORE RELEASE!!!! - ;; ('confirm (next-level!)) - ('menu (show-menu!)))) - ;; Pressing any bound input resets the game. - ('win (if *level-last* - (begin - (load-level! *level-last*) - (set! *level-last* #f)) - (reset-game!)))))) + ;; ('confirm (next-level!)) + ('menu (show-menu!)))) + ('menu + (match input + ('up (menu-up!)) + ('down (menu-down!)) + ('confirm (menu-select!)) + ('menu (hide-menu!)) + (_ #f))) + ;; Pressing any bound input resets the game. + ('win (if *level-last* + (begin + (load-level! *level-last*) + (set! *level-last* #f)) + (reset-game!))))) ;; Canvas and event loop setup (define canvas (get-element-by-id "canvas")) From 8627f06ebd1005a7da73b16c0bac4268a6a5fad4 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Tue, 17 Dec 2024 14:42:15 -0500 Subject: [PATCH 11/20] Avoiding string-append for drawing menu --- game.scm | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/game.scm b/game.scm index a15d09b..a4a7d2f 100644 --- a/game.scm +++ b/game.scm @@ -753,7 +753,9 @@ (1+ menu:max-items) num-items))) (r-start (- -2 padding-y)) - (r-end (- (+ r-start height) padding-y))) + (r-end (- (+ r-start height) padding-y)) + (gutter-x (- (vec2-x center) (* tile-width (1- (floor (/ width 2)))))) + (text-x (+ tile-width gutter-x))) (let row ((r r-start) (y (- (vec2-y center) (* tile-height (floor (/ height 2)))))) ;; Draw menu background @@ -766,21 +768,24 @@ (set-stroke-color! context "blue") (stroke-rect context x y w h))) ;; Draw menu text - (set-text-align! context "center") (set-font! context "normal 16px monogram") (set-fill-color! context "#fff") - (let ((r-index (- (+ r (* (current-menu-page) menu:max-items)) (current-menu-page)))) - (if (= r r-start) - (fill-text context (menu-name (current-menu)) (vec2-x center) (+ y text-offset-y)) - (if (and (>= r -1) (< r-index num-items) (< r r-end)) - (let* ((item (if (= r -1) - (if (= (current-menu-page) 0) - "Back" "...") - (if (and (= r (1- r-end)) (< r-index (1- num-items))) - "..." - (menu-item-name (vector-ref (menu-items (current-menu)) r-index))))) - (text (string-append (if (= r-index (current-menu-index)) "▸ " " ") item))) - (fill-text context text (vec2-x center) (+ y text-offset-y)))))) + (when (= r r-start) + (set-text-align! context "center") + (fill-text context (menu-name (current-menu)) (vec2-x center) (+ y text-offset-y))) + (let* ((r-index (- (+ r (* (current-menu-page) menu:max-items)) (current-menu-page)))) + (set-text-align! context "left") + (if (= r-index (current-menu-index)) + (fill-text context "▸" gutter-x (+ y text-offset-y))) + (if (and (>= r -1) (< r-index num-items) (< r r-end)) + (fill-text context + (if (= r -1) + (if (= (current-menu-page) 0) "Back" "...") + (if (and (= r (1- r-end)) (< r-index (1- num-items))) + "..." + (menu-item-name (vector-ref (menu-items (current-menu)) + r-index)))) + text-x (+ y text-offset-y)))) ;; Draw next row (set! r (1+ r)) (if (< r (+ r-start height)) From 89fa09c387a750f64fa545df66168f30f78191d8 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Wed, 18 Dec 2024 12:37:19 -0500 Subject: [PATCH 12/20] Small logic changes --- game.scm | 47 +++++++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/game.scm b/game.scm index a4a7d2f..38a0c8e 100644 --- a/game.scm +++ b/game.scm @@ -760,36 +760,35 @@ (y (- (vec2-y center) (* tile-height (floor (/ height 2)))))) ;; Draw menu background (when (= r r-start) - (let* ((x (- (vec2-x center) (* tile-width (floor (/ width 2))))) - (w (* tile-width width)) - (h (* tile-height height))) + (let ((x (- (vec2-x center) (* tile-width (floor (/ width 2))))) + (w (* tile-width width)) + (h (* tile-height height))) (set-fill-color! context "#000") (fill-rect context x y w h) (set-stroke-color! context "blue") (stroke-rect context x y w h))) ;; Draw menu text - (set-font! context "normal 16px monogram") - (set-fill-color! context "#fff") - (when (= r r-start) - (set-text-align! context "center") - (fill-text context (menu-name (current-menu)) (vec2-x center) (+ y text-offset-y))) - (let* ((r-index (- (+ r (* (current-menu-page) menu:max-items)) (current-menu-page)))) + (let ((r-menu-index (- (+ r (* (current-menu-page) menu:max-items)) (current-menu-page)))) + (set-font! context "normal 16px monogram") + (set-fill-color! context "#fff") + (when (= r r-start) + (set-text-align! context "center") + (fill-text context (menu-name (current-menu)) (vec2-x center) (+ y text-offset-y))) (set-text-align! context "left") - (if (= r-index (current-menu-index)) - (fill-text context "▸" gutter-x (+ y text-offset-y))) - (if (and (>= r -1) (< r-index num-items) (< r r-end)) - (fill-text context - (if (= r -1) - (if (= (current-menu-page) 0) "Back" "...") - (if (and (= r (1- r-end)) (< r-index (1- num-items))) - "..." - (menu-item-name (vector-ref (menu-items (current-menu)) - r-index)))) - text-x (+ y text-offset-y)))) - ;; Draw next row - (set! r (1+ r)) - (if (< r (+ r-start height)) - (row r (+ y tile-height)))))) + (when (= r-menu-index (current-menu-index)) + (fill-text context "▸" gutter-x (+ y text-offset-y))) + (when (>= r -1) + (fill-text context + (cond + ((= r-menu-index -1) "Back") + ((or (= r -1) (and (= r (1- r-end)) (< r-menu-index (1- num-items)))) + "...") + (else + (menu-item-name (vector-ref (menu-items (current-menu)) r-menu-index)))) + text-x (+ y text-offset-y))) + ;; Draw next row + (when (and (< (1+ r) r-end) (< (1+ r-menu-index) num-items)) + (row (1+ r) (+ y tile-height))))))) (define (draw-level) (draw-background) From 4a46d3d1d11db75ed221d26bcefae42ac24c2dce Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Fri, 20 Dec 2024 08:50:40 -0500 Subject: [PATCH 13/20] Refactoring menu drawing --- game.scm | 72 +++++++++++++++++++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 29 deletions(-) diff --git a/game.scm b/game.scm index 38a0c8e..4207ce8 100644 --- a/game.scm +++ b/game.scm @@ -326,6 +326,7 @@ 'menu menu:level-select) (make-menu-item "Credits" 'credits)))) +;; -1 for the index means 'Back' will be indicated first (define *menu* (make-menu-state menu:main -1 0 '())) (define (current-menu) @@ -750,45 +751,58 @@ (height (+ 2 ;; Menu title + back/ellipses (* 2 padding-y) ;; Padding (if (> num-items menu:max-items) - (1+ menu:max-items) + (1+ menu:max-items) ;; bottom ellipses num-items))) - (r-start (- -2 padding-y)) - (r-end (- (+ r-start height) padding-y)) - (gutter-x (- (vec2-x center) (* tile-width (1- (floor (/ width 2)))))) - (text-x (+ tile-width gutter-x))) - (let row ((r r-start) - (y (- (vec2-y center) (* tile-height (floor (/ height 2)))))) - ;; Draw menu background - (when (= r r-start) - (let ((x (- (vec2-x center) (* tile-width (floor (/ width 2))))) - (w (* tile-width width)) - (h (* tile-height height))) - (set-fill-color! context "#000") - (fill-rect context x y w h) - (set-stroke-color! context "blue") - (stroke-rect context x y w h))) - ;; Draw menu text - (let ((r-menu-index (- (+ r (* (current-menu-page) menu:max-items)) (current-menu-page)))) - (set-font! context "normal 16px monogram") - (set-fill-color! context "#fff") + (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))) + (gutter-x (+ tile-width x-start)) + (text-x (+ tile-width gutter-x))) + (do ((r r-start (1+ r)) (y y-start (+ tile-height y))) + ((or (>= r r-end) (>= (+ r r-page-offset) num-items))) + ;; Draw menu title (when (= r r-start) (set-text-align! context "center") - (fill-text context (menu-name (current-menu)) (vec2-x center) (+ y text-offset-y))) + (fill-text context (menu-name (current-menu)) + (vec2-x center) (+ y text-offset-y))) (set-text-align! context "left") - (when (= r-menu-index (current-menu-index)) + ;; indicator + (when (= (+ r r-page-offset) (current-menu-index)) (fill-text context "▸" gutter-x (+ y text-offset-y))) + ;; Menu items (when (>= r -1) (fill-text context (cond - ((= r-menu-index -1) "Back") - ((or (= r -1) (and (= r (1- r-end)) (< r-menu-index (1- num-items)))) + ((= (+ r r-page-offset) -1) "Back") + ((or (= r -1) (and (= r (1- r-end)) + (< (+ r r-page-offset) (1- num-items)))) "...") (else - (menu-item-name (vector-ref (menu-items (current-menu)) r-menu-index)))) - text-x (+ y text-offset-y))) - ;; Draw next row - (when (and (< (1+ r) r-end) (< (1+ r-menu-index) num-items)) - (row (1+ r) (+ y tile-height))))))) + (menu-item-name + (vector-ref (menu-items (current-menu)) + (+ r r-page-offset))))) + text-x (+ y text-offset-y))))))) (define (draw-level) (draw-background) From 3f463a9a61d992e32244702675edace49affafe4 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Fri, 20 Dec 2024 08:59:28 -0500 Subject: [PATCH 14/20] Remove commented code --- modules/dom/canvas.scm | 3 --- 1 file changed, 3 deletions(-) diff --git a/modules/dom/canvas.scm b/modules/dom/canvas.scm index 46dc8fa..a75fc09 100644 --- a/modules/dom/canvas.scm +++ b/modules/dom/canvas.scm @@ -77,9 +77,6 @@ (define-foreign draw-image "canvas" "drawImage" (ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none) -;; (define-foreign stroke -;; "canvas" "stroke" -;; (ref extern) -> none) (define-foreign restore! "canvas" "restore" (ref extern) -> none) From b248ea72ad11a7cb2d7629c5edf25c01368c2a55 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Fri, 20 Dec 2024 09:09:12 -0500 Subject: [PATCH 15/20] Changing the way game state is handled --- game.scm | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/game.scm b/game.scm index 4207ce8..3f26f6b 100644 --- a/game.scm +++ b/game.scm @@ -106,15 +106,21 @@ (define audio:bg-music (load-music "cirkoban")) ;; Game state -(define *state* (list #f)) +(define *state* '()) (define (push-game-state! state) (set! *state* (cons state *state*))) (define (pop-game-state!) - (set! *state* (cdr *state*))) - -(define (current-game-state) (car *state*)) + (when (pair? *state*) + (set! *state* (cdr *state*)))) +(define (replace-game-state! state) + (if (pair? *state*) + (set! *state* (cons state (cdr *state*))) + (set! *state* (list state)))) +(define (current-game-state) + (when (pair? *state*) + (car *state*))) (define *actormap* (make-whactormap)) @@ -214,7 +220,7 @@ (memq idx *gems*)) (define (set-level! idx) - (push-game-state! 'play) + (replace-game-state! 'play) (set! *actormap* (make-whactormap)) (clear-snapshots!) (with-goblins @@ -222,7 +228,7 @@ (update-objects!))) (define (load-credits!) - (push-game-state! 'win) + (replace-game-state! 'win) (set! *actormap* (make-whactormap)) (set-vec2-y! *credits-scroll* 0.0) (clear-snapshots!) @@ -239,7 +245,7 @@ (begin (run-script (lambda () - (push-game-state! 'interstitial) + (replace-game-state! 'interstitial) (yield (lambda (k) (show-effect! (make-fade-out+in-effect 1.0 k)))) @@ -249,7 +255,7 @@ (begin (run-script (lambda () - (push-game-state! 'interstitial) + (replace-game-state! 'interstitial) (yield (lambda (k) (show-effect! (make-fade-out+in-effect 2.0 k)))) @@ -403,7 +409,7 @@ (define (reset-game!) (run-script (lambda () - (push-game-state! 'interstitial) + (set! *state* '(interstitial)) (yield (lambda (k) (show-effect! (make-fade-out+in-effect 2.0 k)))) From b468bab15963112ec140aca52fc5c00eb2acb59c Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Fri, 20 Dec 2024 09:16:30 -0500 Subject: [PATCH 16/20] Using menu item actions instead of type and payload --- game.scm | 55 +++++++++++++++++++++++-------------------------------- 1 file changed, 23 insertions(+), 32 deletions(-) diff --git a/game.scm b/game.scm index 3f26f6b..3819cb9 100644 --- a/game.scm +++ b/game.scm @@ -307,15 +307,21 @@ (page menu-state-page set-menu-state-page!) (history menu-state-history set-menu-state-history!)) -(define-record-type - (_make-menu-item name type payload) - menu-item? - (name menu-item-name) - (type menu-item-type) - (payload menu-item-payload)) +(define (menu-action:submenu menu) + (lambda () + (push-menu-history!) + (set-menu! menu) + (set-menu-index! -1))) -(define* (make-menu-item name type #:optional payload) - (_make-menu-item name type payload)) +(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))) @@ -324,13 +330,13 @@ (let ((items (make-vector (vector-length levels)))) (do ((i 0 (1+ i))) ((= i (vector-length levels))) - (vector-set! items i (make-menu-item (string-append "Level " (number->string i)) - 'level i))) + (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 (make-menu-item "Select Level" - 'menu menu:level-select) - (make-menu-item "Credits" 'credits)))) + (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 '())) @@ -388,23 +394,9 @@ (set-menu-history! rest)))) (define (menu-select!) - (if (= (current-menu-index) -1) + (if (= (current-menu-index) -1) ;; back button pressed (pop-menu-history!) - (let* ((item (vector-ref (menu-items (current-menu)) (current-menu-index))) - (type (menu-item-type item)) - (payload (menu-item-payload item))) - (match type - ('menu - (push-menu-history!) - (set-menu! payload) - (set-menu-index! -1)) - ('level - (hide-menu!) - (load-level! payload)) - ('credits - (hide-menu!) - (set! *level-last* *level-idx*) - (load-level! (vector-length levels))))))) + ((cdr (vector-ref (menu-items (current-menu)) (current-menu-index)))))) (define (reset-game!) (run-script @@ -805,9 +797,8 @@ (< (+ r r-page-offset) (1- num-items)))) "...") (else - (menu-item-name - (vector-ref (menu-items (current-menu)) - (+ r r-page-offset))))) + (car (vector-ref (menu-items (current-menu)) + (+ r r-page-offset))))) text-x (+ y text-offset-y))))))) (define (draw-level) From b29c13e0fc5b11dc00f0dbaa37b53b5014bbc3cf Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Fri, 20 Dec 2024 10:14:44 -0500 Subject: [PATCH 17/20] Replace 'win state with 'credits, refactoring level drawing --- game.scm | 79 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 41 insertions(+), 38 deletions(-) diff --git a/game.scm b/game.scm index 3819cb9..02dfc37 100644 --- a/game.scm +++ b/game.scm @@ -228,7 +228,7 @@ (update-objects!))) (define (load-credits!) - (replace-game-state! 'win) + (replace-game-state! 'credits) (set! *actormap* (make-whactormap)) (set-vec2-y! *credits-scroll* 0.0) (clear-snapshots!) @@ -371,14 +371,14 @@ (define (menu-up!) (set-menu-index! (max -1 (1- (current-menu-index)))) - (if (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))))) + (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)))) - (if (= (current-menu-index) (- (* (1+ (current-menu-page)) menu:max-items) (current-menu-page))) - (set-menu-page! (1+ (current-menu-page))))) + (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) @@ -801,6 +801,26 @@ (+ r r-page-offset))))) text-x (+ y text-offset-y))))))) +(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) (draw-background) (for-each draw-object *objects*) @@ -814,7 +834,9 @@ (set-font! context "normal 32px monogram") (set-fill-color! context "#ffffff") (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) (draw-level)) @@ -869,7 +891,7 @@ (define credits-line-spacing 16.0) (define max-credits-scroll (+ game-height (* (- (vector-length credits) 9) credits-line-spacing))) -(define (draw-win) +(define (draw-credits) (draw-level) (set-fill-color! context "#ffffff") (set-text-align! context "center") @@ -920,33 +942,13 @@ (scale! context *canvas-scale* *canvas-scale*) (draw-current-effect 'pre) - (let ((state (current-game-state))) - (match state - ((or 'menu 'play 'interstitial) - (draw-level) - ;; Display input mappings on the title screen/first level. - (when (= *level-idx* 0) - (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))) - (when (eq? 'menu state) - (draw-menu))) - ('win (draw-win)))) + (match (current-game-state) + ((or 'play 'interstitial) + (draw-level)) + ('menu + (draw-level) + (draw-menu)) + ('credits (draw-credits))) (draw-current-effect 'post) (request-animation-frame draw-callback))) (define draw-callback (procedure->external draw)) @@ -1058,11 +1060,12 @@ ('menu (hide-menu!)) (_ #f))) ;; Pressing any bound input resets the game. - ('win (if *level-last* - (begin + ;; 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)) - (reset-game!))))) + (else (reset-game!)))))) ;; Canvas and event loop setup (define canvas (get-element-by-id "canvas")) From 514c7db401ea892293d9818e7c604eafb0dbe4bb Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Fri, 20 Dec 2024 10:21:10 -0500 Subject: [PATCH 18/20] Moving default value to parameter list --- game.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/game.scm b/game.scm index 02dfc37..de64010 100644 --- a/game.scm +++ b/game.scm @@ -359,9 +359,9 @@ (set-menu-state-history! *menu* history)) ;; Menu commands -(define* (show-menu! #:optional menu) +(define* (show-menu! #:optional (menu menu:main)) (push-game-state! 'menu) - (set-menu! (or menu menu:main)) + (set-menu! menu) (set-menu-index! -1) (set-menu-page! 0) (set-menu-history! '())) From 27b6a4d840d23994e8071cfe7ee226481c898e92 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Tue, 31 Dec 2024 13:14:17 -0500 Subject: [PATCH 19/20] Setting initial game state Use matching for game state procedures --- game.scm | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/game.scm b/game.scm index de64010..fc56b42 100644 --- a/game.scm +++ b/game.scm @@ -106,7 +106,7 @@ (define audio:bg-music (load-music "cirkoban")) ;; Game state -(define *state* '()) +(define *state* '(initial)) (define (push-game-state! state) (set! *state* (cons state *state*))) @@ -114,14 +114,12 @@ (when (pair? *state*) (set! *state* (cdr *state*)))) (define (replace-game-state! state) - (if (pair? *state*) - (set! *state* (cons state (cdr *state*))) - (set! *state* (list state)))) - + (match *state* + ((_ . rest) + (set! *state* (cons state rest))))) (define (current-game-state) - (when (pair? *state*) - (car *state*))) - + (match *state* + ((state . _) state))) (define *actormap* (make-whactormap)) (define (call-with-goblins thunk) @@ -401,7 +399,7 @@ (define (reset-game!) (run-script (lambda () - (set! *state* '(interstitial)) + (replace-game-state! 'interstitial) (yield (lambda (k) (show-effect! (make-fade-out+in-effect 2.0 k)))) @@ -1049,9 +1047,10 @@ ('undo (rollback-snapshot!) (with-goblins (update-objects!))) - ;; REMOVE BEFORE RELEASE!!!! + ;; REMOVE BEFORE RELEASE!!!! ;; ('confirm (next-level!)) - ('menu (show-menu!)))) + ('menu (show-menu!)) + (_ #f))) ('menu (match input ('up (menu-up!)) @@ -1061,11 +1060,12 @@ (_ #f))) ;; Pressing any bound input resets the 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!)))))) + ('credits + (cond + (*level-last* + (load-level! *level-last*) + (set! *level-last* #f)) + (else (reset-game!)))))) ;; Canvas and event loop setup (define canvas (get-element-by-id "canvas")) From 93e666f1bf066d28211464ead2068795ec4ba1c9 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Tue, 31 Dec 2024 13:15:03 -0500 Subject: [PATCH 20/20] Simplified menu drawing; standardized variable names --- game.scm | 51 +++++++++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/game.scm b/game.scm index fc56b42..493aa18 100644 --- a/game.scm +++ b/game.scm @@ -742,7 +742,7 @@ ;; + the y padding again (let* ((padding-y 1) (text-offset-y (* 0.75 tile-height)) - (width 8) + (width 8.0) (num-items (vector-length (menu-items (current-menu)))) (height (+ 2 ;; Menu title + back/ellipses (* 2 padding-y) ;; Padding @@ -773,31 +773,34 @@ (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))) - (gutter-x (+ tile-width x-start)) - (text-x (+ tile-width gutter-x))) + (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))) - ;; Draw menu title - (when (= r r-start) - (set-text-align! context "center") - (fill-text context (menu-name (current-menu)) - (vec2-x center) (+ y text-offset-y))) - (set-text-align! context "left") - ;; indicator - (when (= (+ r r-page-offset) (current-menu-index)) - (fill-text context "▸" gutter-x (+ y text-offset-y))) - ;; Menu items - (when (>= r -1) - (fill-text context - (cond - ((= (+ r r-page-offset) -1) "Back") - ((or (= r -1) (and (= r (1- r-end)) - (< (+ r r-page-offset) (1- num-items)))) - "...") - (else - (car (vector-ref (menu-items (current-menu)) - (+ r r-page-offset))))) - text-x (+ y text-offset-y))))))) + (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))