SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added paging to menu

Browse source
This commit is contained in:
Amy Grinn 2024-12-12 12:47:54 -05:00
parent d6506a6e6d
commit dbca0ba6cf
No known key found for this signature in database
GPG key ID: 6B558BED1DCF3192
1 changed files with 82 additions and 56 deletions

130
game.scm
View file

@ -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)
(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
(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*))))
(let* ((item (or (and (= r -1) "Back")
(menu-item-name (vector-ref (menu-items *menu*) r))))
(text (string-append (or (and (= r *menu:index*) "▸ ") " ")
((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)))))
(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)