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

Enter and leave sub-menus

Browse source 
Created record types for menus and menu items
This commit is contained in:
Amy Grinn 2024-12-12 09:18:02 -05:00
parent 7bf1d20147
commit d6506a6e6d
No known key found for this signature in database
GPG key ID: 6B558BED1DCF3192
1 changed files with 54 additions and 15 deletions

69
game.scm
View file

@ -61,7 +61,8 @@
(local-storage)
(math)
(math rect)
(math vector))
(math vector)
(scheme base))
(define game-width 320.0)
(define game-height 240.0)
@ -110,6 +111,20 @@
;; 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)
@ -275,19 +290,40 @@
(define (show-menu!)
(set! *menu* menu:main)
(set! *menu:index* 0))
(set! *menu:index* -1)
(set! *menu:history* '()))
(define (menu-up!)
(set! *menu:index* (max -1 (1- *menu:index*))))
(define (menu-down!)
(set! *menu:index* (min (1- (vector-length *menu*)) (1+ *menu:index*))))
(set! *menu:index* (min (1- (vector-length (menu-items *menu*))) (1+ *menu:index*))))
(define (hide-menu!)
(set! *menu* #f))
(define (menu-select!)
"TODO select the current index of the menu.")
(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*))
(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)))))))
(define (reset-game!)
(run-script
@ -627,16 +663,19 @@
(id (level-tile-id tile)))
(draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
(define menu:main #(("Select Level" . menu:level-select)
("Credits" . menu:credits)))
(define menu:level-select
(let ((menu (make-vector (vector-length levels))))
(let ((items (make-vector (vector-length levels))))
(do ((i 0 (1+ i)))
((= i (vector-length levels)))
(vector-set! menu i (cons (string-append "Level " (number->string i))
(vector-ref levels i))))
menu))
(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)))
@ -649,7 +688,7 @@
(let* ((padding-y 1)
(text-offset-y (* 0.75 tile-height))
(width 6)
(height (min level-height (+ 2 (* 2 padding-y) (vector-length *menu*))))
(height (min level-height (+ 2 (* 2 padding-y) (vector-length (menu-items *menu*)))))
(r-start (- -2 padding-y)))
(let row ((r r-start)
(y (- (vec2-y center) (* tile-height (floor (/ height 2))))))
@ -661,10 +700,10 @@
;; Draw menu text
(cond
((= r r-start)
(fill-text context "Menu" (vec2-x center) (+ y text-offset-y)))
((and (>= r -1) (< r (vector-length *menu*)))
(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")
(car (vector-ref *menu* r))))
(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)))))