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

Combining menu state into a single record

Browse source
This commit is contained in:
Amy Grinn 2024-12-13 15:31:19 -05:00
parent 20948a5955
commit 06a982747e
No known key found for this signature in database
GPG key ID: 6B558BED1DCF3192
2 changed files with 130 additions and 100 deletions

164
game.scm
View file

@ -275,20 +275,54 @@
(media-play audio:bg-music)))))
;; Menu types
(define-record-type <menu>
(make-menu name items)
menu?
(name menu-name)
(items menu-items))
;; Menu state
(define-record-type <menu-state>
(make-menu-state current index page history)
menu-state?
(current menu-state-current set-menu-state-current!)
(index menu-state-index set-menu-state-index!)
(page menu-state-page set-menu-state-page!)
(history menu-state-history set-menu-state-history!))
(define *menu* (make-menu-state #f -1 0 '()))
(define (current-menu)
(menu-state-current *menu*))
(define (current-menu-index)
(menu-state-index *menu*))
(define (current-menu-page)
(menu-state-page *menu*))
(define (current-menu-history)
(menu-state-history *menu*))
(define (set-menu! menu)
(set-menu-state-current! *menu* menu))
(define (set-menu-index! index)
(set-menu-state-index! *menu* index))
(define (set-menu-page! page)
(set-menu-state-page! *menu* page))
(define (set-menu-history! history)
(set-menu-state-history! *menu* history))
(define-record-type <menu-item>
(make-menu-item name type payload)
(_make-menu-item name type payload)
menu-item?
(name menu-item-name)
(type menu-item-type)
(payload menu-item-payload))
(define* (make-menu-item name type #:optional payload)
(_make-menu-item name type payload))
;; Menu constants
(define center (vec2 (* 10.0 tile-width) (* 7.0 tile-height)))
(define menu:max-items 10)
(define menu:level-select
(let ((items (make-vector (vector-length levels))))
@ -301,64 +335,60 @@
(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* '())
(make-menu-item "Credits" 'credits))))
;; Menu commands
(define (show-menu!)
(set! *menu* menu:main)
(set! *menu:index* -1)
(set! *menu:history* '())
(set! *menu:page* 0))
(define (menu-up!)
(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*)))
(if (= *menu:index* (- (* (1+ *menu:page*) menu:max-items) *menu:page*))
(set! *menu:page* (1+ *menu:page*))))
(define* (show-menu! #:optional menu)
(set-menu! (or menu menu:main))
(set-menu-index! -1)
(set-menu-page! 0)
(set-menu-history! '()))
(define (hide-menu!)
(set! *menu* #f))
(set-menu! #f))
(define (menu-up!)
(set-menu-index! (max -1 (1- (current-menu-index))))
(if (and (> (current-menu-page) 0)
(= (current-menu-index) (- (* (current-menu-page) menu:max-items) (current-menu-page) 1)))
(set-menu-page! (1- (current-menu-page)))))
(define (menu-down!)
(set-menu-index! (min (1- (vector-length (menu-items (current-menu)))) (1+ (current-menu-index))))
(if (= (current-menu-index) (- (* (1+ (current-menu-page)) menu:max-items) (current-menu-page)))
(set-menu-page! (1+ (current-menu-page)))))
(define (push-menu-history!)
(set-menu-history! (cons (cons (current-menu)
(current-menu-index))
(current-menu-history))))
(define (pop-menu-history!)
(match (current-menu-history)
(() (hide-menu!))
(((prev . index) . rest)
(set-menu! prev)
(set-menu-index! index)
(set-menu-history! rest))))
(define (menu-select!)
(cond
;; Back button
((= *menu:index* -1)
(cond
((null? *menu:history*)
(hide-menu!))
(else
(let ((last (car *menu:history*)))
(set! *menu* (car last))
(set! *menu:index* (cdr last)))
(set! *menu:history* (cdr *menu:history*)))))
(else
(let* ((item (vector-ref (menu-items *menu*) *menu:index*))
(if (= (current-menu-index) -1)
(pop-menu-history!)
(let* ((item (vector-ref (menu-items (current-menu)) (current-menu-index)))
(type (menu-item-type item))
(payload (menu-item-payload item)))
(match type
;; Sub menu
('menu
(set! *menu:history* (cons (cons *menu* *menu:index*) *menu:history*))
(set! *menu* payload)
(set! *menu:index* -1))
(push-menu-history!)
(set-menu! payload)
(set-menu-index! -1))
('level
(hide-menu!)
(load-level! payload))
('credits
(hide-menu!)
(set! *level-last* *level-idx*)
(load-level! (vector-length levels))))))))
(load-level! (vector-length levels)))))))
(define (reset-game!)
(run-script
@ -699,8 +729,6 @@
(draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
(define center (vec2 (* 10.0 tile-width) (* 7.0 tile-height)))
(define (draw-menu)
;; Height (in tiles) will be 1 for the menu title + the y padding
;; + 1 for the back button if on the first page or ellipses otherwise
@ -709,13 +737,12 @@
(let* ((padding-y 1)
(text-offset-y (* 0.75 tile-height))
(width 8)
(num-items (vector-length (menu-items *menu*)))
(num-items (vector-length (menu-items (current-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))))
(if (> num-items menu:max-items)
(1+ menu:max-items)
num-items)))
(r-start (- -2 padding-y))
(r-end (- (+ r-start height) padding-y)))
(let row ((r r-start)
@ -731,17 +758,18 @@
(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)))
(let ((r-index (- (+ r (* (current-menu-page) menu:max-items)) (current-menu-page))))
(if (= r r-start)
(fill-text context (menu-name (current-menu)) (vec2-x center) (+ y text-offset-y))
(if (and (>= r -1) (< r-index num-items) (< r r-end))
(let* ((item (cond
((= r -1)
(if (= (current-menu-page) 0) "Back" "..."))
((and (= r (1- r-end)) (< r-index (1- num-items)))
"...")
(else
(menu-item-name (vector-ref (menu-items (current-menu)) r-index)))))
(text (string-append (if (= r-index (current-menu-index)) "▸ " " ") item)))
(fill-text context text (vec2-x center) (+ y text-offset-y))))))
;; Draw next row
(set! r (1+ r))
@ -891,7 +919,7 @@
(fill-text context "A -> undo"
cx2 baseline))))
('win (draw-win)))
(if *menu* (draw-menu))
(if (current-menu) (draw-menu))
(draw-current-effect 'post)
(request-animation-frame draw-callback)))
(define draw-callback (procedure->external draw))
@ -982,14 +1010,12 @@
(on-input-down 'undo))))))))
(define (on-input-down input)
(cond
(*menu*
(if (current-menu)
(match input
('up (menu-up!))
('down (menu-down!))
('confirm (menu-select!))
('menu (hide-menu!))))
(else
('menu (hide-menu!)))
(match *state*
('play
(match input
@ -1004,11 +1030,11 @@
;; ('confirm (next-level!))
('menu (show-menu!))))
;; Pressing any bound input resets the game.
('win (cond
(*level-last*
('win (if *level-last*
(begin
(load-level! *level-last*)
(set! *level-last* #f))
(else (reset-game!))))))))
(reset-game!))))))
;; Canvas and event loop setup
(define canvas (get-element-by-id "canvas"))

4
modules/dom/canvas.scm
View file

@ -29,6 +29,7 @@
set-text-align!
clear-rect
fill-rect
;; stroke
fill-text
draw-image
restore!
@ -72,6 +73,9 @@
(define-foreign draw-image
"canvas" "drawImage"
(ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
;; (define-foreign stroke
;; "canvas" "stroke"
;; (ref extern) -> none)
(define-foreign restore!
"canvas" "restore"
(ref extern) -> none)