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

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