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