Added paging to menu
This commit is contained in:
parent
d6506a6e6d
commit
dbca0ba6cf
1 changed files with 82 additions and 56 deletions
130
game.scm
130
game.scm
|
@ -108,24 +108,6 @@
|
||||||
;; Game state
|
;; Game state
|
||||||
(define *state* #f)
|
(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 *actormap* (make-whactormap))
|
||||||
(define (call-with-goblins thunk)
|
(define (call-with-goblins thunk)
|
||||||
(actormap-churn-run! *actormap* thunk))
|
(actormap-churn-run! *actormap* thunk))
|
||||||
|
@ -288,16 +270,58 @@
|
||||||
(load-level! *level-idx*)
|
(load-level! *level-idx*)
|
||||||
(media-play audio:bg-music)))))
|
(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!)
|
(define (show-menu!)
|
||||||
(set! *menu* menu:main)
|
(set! *menu* menu:main)
|
||||||
(set! *menu:index* -1)
|
(set! *menu:index* -1)
|
||||||
(set! *menu:history* '()))
|
(set! *menu:history* '())
|
||||||
|
(set! *menu:page* 0))
|
||||||
|
|
||||||
(define (menu-up!)
|
(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!)
|
(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!)
|
(define (hide-menu!)
|
||||||
(set! *menu* #f))
|
(set! *menu* #f))
|
||||||
|
@ -663,53 +687,55 @@
|
||||||
(id (level-tile-id tile)))
|
(id (level-tile-id tile)))
|
||||||
(draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
|
(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 center (vec2 (* 10.0 tile-width) (* 7.0 tile-height)))
|
||||||
|
|
||||||
(define (draw-menu)
|
(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
|
;; 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)
|
(let* ((padding-y 1)
|
||||||
(text-offset-y (* 0.75 tile-height))
|
(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)
|
(let row ((r r-start)
|
||||||
(y (- (vec2-y center) (* tile-height (floor (/ height 2))))))
|
(y (- (vec2-y center) (* tile-height (floor (/ height 2))))))
|
||||||
;; Draw menu background
|
;; 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
|
;; 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
|
(cond
|
||||||
((= r r-start)
|
((= r r-start)
|
||||||
(fill-text context (menu-name *menu*) (vec2-x center) (+ y text-offset-y)))
|
(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)))
|
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
|
;; 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)
|
(define (draw-level)
|
||||||
(draw-background)
|
(draw-background)
|
||||||
|
|
Loading…
Add table
Reference in a new issue