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
Show stats Download patch file Download diff file Expand all files Collapse all files

164
game.scm
View file

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

4
modules/dom/canvas.scm
View file

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