Added paging to menu

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 <menu>
-  (make-menu name items)
-  menu?
-  (name menu-name)
-  (items menu-items))
-
-(define-record-type <menu-item>
-  (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 <menu>
+  (make-menu name items)
+  menu?
+  (name menu-name)
+  (items menu-items))
+
+(define-record-type <menu-item>
+  (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)
+         (width 8)
-         (height (min level-height (+ 2 (* 2 padding-y) (vector-length (menu-items *menu*)))))
+         (num-items (vector-length (menu-items *menu*)))
-         (r-start (- -2 padding-y)))
+         (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)))
+      (if (= r r-start)
-          ((= c (floor (/ width 2))))
+          (let* ((x1 (- (vec2-x center) (* tile-width (floor (/ width 2)))))
-        (let ((x (+ (vec2-x center) (* tile-width c))))
+                 (w (* tile-width width))
-          (draw-tile context tileset 109 x y)))
+                 (h (* tile-height height)))
+            (set-fill-color! context "#000")
+            (fill-rect context x1 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 (* *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 (vector-length (menu-items *menu*))))
+         ((and (>= r -1) (< r-index num-items) (< r r-end))
-        (let* ((item (or (and (= r -1) "Back")
+          (let* ((item (or (and (= r -1) (or (and (= *menu:page* 0) "Back")
-                         (menu-item-name (vector-ref (menu-items *menu*) r))))
+                                             "..."))
-               (text (string-append (or (and (= r *menu:index*) "▸ ") "  ")
+                           (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)))))
+            (fill-text context text (vec2-x center) (+ y text-offset-y))))))
       ;; Draw next row
-      (if (< (1+ r) (+ r-start height))
+      (set! r (1+ r))
-          (row (1+ r) (+ y tile-height))))))
+      (if (< r (+ r-start height))
+          (row r (+ y tile-height))))))
 
 (define (draw-level)
   (draw-background)