From d6506a6e6d122be57f5b8950d82fed46b0d54b16 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Thu, 12 Dec 2024 09:18:02 -0500 Subject: [PATCH] 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)))))