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)