Combining menu state into a single record
This commit is contained in:
Amy Grinn
parent
20948a5955
commit
06a982747e
2 changed files with 130 additions and 100 deletions
226
game.scm
226
game.scm
|
|
@ -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
|
(type (menu-item-type item))
|
||||||
((null? *menu:history*)
|
(payload (menu-item-payload item)))
|
||||||
(hide-menu!))
|
(match type
|
||||||
(else
|
('menu
|
||||||
(let ((last (car *menu:history*)))
|
(push-menu-history!)
|
||||||
(set! *menu* (car last))
|
(set-menu! payload)
|
||||||
(set! *menu:index* (cdr last)))
|
(set-menu-index! -1))
|
||||||
(set! *menu:history* (cdr *menu:history*)))))
|
('level
|
||||||
(else
|
(hide-menu!)
|
||||||
(let* ((item (vector-ref (menu-items *menu*) *menu:index*))
|
(load-level! payload))
|
||||||
(type (menu-item-type item))
|
('credits
|
||||||
(payload (menu-item-payload item)))
|
(hide-menu!)
|
||||||
(match type
|
(set! *level-last* *level-idx*)
|
||||||
;; Sub menu
|
(load-level! (vector-length levels)))))))
|
||||||
('menu
|
|
||||||
(set! *menu:history* (cons (cons *menu* *menu:index*) *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))))))))
|
|
||||||
|
|
||||||
(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,18 +758,19 @@
|
||||||
(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)))))
|
||||||
(fill-text context text (vec2-x center) (+ y text-offset-y))))))
|
(text (string-append (if (= r-index (current-menu-index)) "▸ " " ") item)))
|
||||||
|
(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))
|
||||||
(if (< r (+ r-start height))
|
(if (< r (+ r-start height))
|
||||||
|
|
@ -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,33 +1010,31 @@
|
||||||
(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!))))
|
(match *state*
|
||||||
(else
|
('play
|
||||||
(match *state*
|
(match input
|
||||||
('play
|
('left (move-player 'left))
|
||||||
(match input
|
('right (move-player 'right))
|
||||||
('left (move-player 'left))
|
('up (move-player 'up))
|
||||||
('right (move-player 'right))
|
('down (move-player 'down))
|
||||||
('up (move-player 'up))
|
('undo
|
||||||
('down (move-player 'down))
|
(rollback-snapshot!)
|
||||||
('undo
|
(with-goblins (update-objects!)))
|
||||||
(rollback-snapshot!)
|
;; REMOVE BEFORE RELEASE!!!!
|
||||||
(with-goblins (update-objects!)))
|
;; ('confirm (next-level!))
|
||||||
;; REMOVE BEFORE RELEASE!!!!
|
('menu (show-menu!))))
|
||||||
;; ('confirm (next-level!))
|
;; Pressing any bound input resets the game.
|
||||||
('menu (show-menu!))))
|
('win (if *level-last*
|
||||||
;; Pressing any bound input resets the game.
|
(begin
|
||||||
('win (cond
|
(load-level! *level-last*)
|
||||||
(*level-last*
|
(set! *level-last* #f))
|
||||||
(load-level! *level-last*)
|
(reset-game!))))))
|
||||||
(set! *level-last* #f))
|
|
||||||
(else (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"))
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue