Created game state history

This commit is contained in:
Amy Grinn 2024-12-17 13:59:47 -05:00
parent 0e5fc5a73b
commit a42d5c5656
No known key found for this signature in database
GPG key ID: 6B558BED1DCF3192

View file

@ -106,7 +106,16 @@
(define audio:bg-music (load-music "cirkoban")) (define audio:bg-music (load-music "cirkoban"))
;; Game state ;; Game state
(define *state* #f) (define *state* (list #f))
(define (push-game-state! state)
(set! *state* (cons state *state*)))
(define (pop-game-state!)
(set! *state* (cdr *state*)))
(define (current-game-state) (car *state*))
(define *actormap* (make-whactormap)) (define *actormap* (make-whactormap))
(define (call-with-goblins thunk) (define (call-with-goblins thunk)
@ -205,7 +214,7 @@
(memq idx *gems*)) (memq idx *gems*))
(define (set-level! idx) (define (set-level! idx)
(set! *state* 'play) (push-game-state! 'play)
(set! *actormap* (make-whactormap)) (set! *actormap* (make-whactormap))
(clear-snapshots!) (clear-snapshots!)
(with-goblins (with-goblins
@ -213,7 +222,7 @@
(update-objects!))) (update-objects!)))
(define (load-credits!) (define (load-credits!)
(set! *state* 'win) (push-game-state! 'win)
(set! *actormap* (make-whactormap)) (set! *actormap* (make-whactormap))
(set-vec2-y! *credits-scroll* 0.0) (set-vec2-y! *credits-scroll* 0.0)
(clear-snapshots!) (clear-snapshots!)
@ -230,7 +239,7 @@
(begin (begin
(run-script (run-script
(lambda () (lambda ()
(set! *state* 'interstitial) (push-game-state! 'interstitial)
(yield (yield
(lambda (k) (lambda (k)
(show-effect! (make-fade-out+in-effect 1.0 k)))) (show-effect! (make-fade-out+in-effect 1.0 k))))
@ -240,7 +249,7 @@
(begin (begin
(run-script (run-script
(lambda () (lambda ()
(set! *state* 'interstitial) (push-game-state! 'interstitial)
(yield (yield
(lambda (k) (lambda (k)
(show-effect! (make-fade-out+in-effect 2.0 k)))) (show-effect! (make-fade-out+in-effect 2.0 k))))
@ -292,25 +301,6 @@
(page menu-state-page set-menu-state-page!) (page menu-state-page set-menu-state-page!)
(history menu-state-history set-menu-state-history!)) (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?
@ -330,22 +320,41 @@
((= i (vector-length levels))) ((= i (vector-length levels)))
(vector-set! items i (make-menu-item (string-append "Level " (number->string i)) (vector-set! items i (make-menu-item (string-append "Level " (number->string i))
'level i))) 'level i)))
(make-menu "Select Level" items))) (make-menu "Select Level" items)))
(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)))) (make-menu-item "Credits" 'credits))))
(define *menu* (make-menu-state menu:main -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))
;; Menu commands ;; Menu commands
(define* (show-menu! #:optional menu) (define* (show-menu! #:optional menu)
(push-game-state! 'menu)
(set-menu! (or menu menu:main)) (set-menu! (or menu menu:main))
(set-menu-index! -1) (set-menu-index! -1)
(set-menu-page! 0) (set-menu-page! 0)
(set-menu-history! '())) (set-menu-history! '()))
(define (hide-menu!) (define (hide-menu!)
(set-menu! #f)) (pop-game-state!))
(define (menu-up!) (define (menu-up!)
(set-menu-index! (max -1 (1- (current-menu-index)))) (set-menu-index! (max -1 (1- (current-menu-index))))
@ -393,7 +402,7 @@
(define (reset-game!) (define (reset-game!)
(run-script (run-script
(lambda () (lambda ()
(set! *state* 'interstitial) (push-game-state! 'interstitial)
(yield (yield
(lambda (k) (lambda (k)
(show-effect! (make-fade-out+in-effect 2.0 k)))) (show-effect! (make-fade-out+in-effect 2.0 k))))
@ -896,8 +905,9 @@
(scale! context *canvas-scale* *canvas-scale*) (scale! context *canvas-scale* *canvas-scale*)
(draw-current-effect 'pre) (draw-current-effect 'pre)
(match *state* (let ((state (current-game-state)))
((or 'play 'interstitial) (match state
((or 'menu 'play 'interstitial)
(draw-level) (draw-level)
;; Display input mappings on the title screen/first level. ;; Display input mappings on the title screen/first level.
(when (= *level-idx* 0) (when (= *level-idx* 0)
@ -918,9 +928,10 @@
(fill-text context "dpad -> move" (fill-text context "dpad -> move"
cx2 (- baseline 16.0)) cx2 (- baseline 16.0))
(fill-text context "A -> undo" (fill-text context "A -> undo"
cx2 baseline)))) cx2 baseline)))
('win (draw-win))) (when (eq? 'menu state)
(if (current-menu) (draw-menu)) (draw-menu)))
('win (draw-win))))
(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))
@ -1011,13 +1022,7 @@
(on-input-down 'undo)))))))) (on-input-down 'undo))))))))
(define (on-input-down input) (define (on-input-down input)
(if (current-menu) (match (current-game-state)
(match input
('up (menu-up!))
('down (menu-down!))
('confirm (menu-select!))
('menu (hide-menu!)))
(match *state*
('play ('play
(match input (match input
('left (move-player 'left)) ('left (move-player 'left))
@ -1030,12 +1035,19 @@
;; REMOVE BEFORE RELEASE!!!! ;; REMOVE BEFORE RELEASE!!!!
;; ('confirm (next-level!)) ;; ('confirm (next-level!))
('menu (show-menu!)))) ('menu (show-menu!))))
('menu
(match input
('up (menu-up!))
('down (menu-down!))
('confirm (menu-select!))
('menu (hide-menu!))
(_ #f)))
;; Pressing any bound input resets the game. ;; Pressing any bound input resets the game.
('win (if *level-last* ('win (if *level-last*
(begin (begin
(load-level! *level-last*) (load-level! *level-last*)
(set! *level-last* #f)) (set! *level-last* #f))
(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"))