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

Created game state history

Browse source
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
1 changed files with 89 additions and 77 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

164
game.scm
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,31 +905,33 @@
(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
(draw-level) ((or 'menu 'play 'interstitial)
;; Display input mappings on the title screen/first level. (draw-level)
(when (= *level-idx* 0) ;; Display input mappings on the title screen/first level.
(let ((cx1 (/ game-width 4.0)) (when (= *level-idx* 0)
(cx2 (* game-width 0.75)) (let ((cx1 (/ game-width 4.0))
(baseline (/ game-height 2.0))) (cx2 (* game-width 0.75))
(set-fill-color! context "#ffffff") (baseline (/ game-height 2.0)))
(set-text-align! context "center") (set-fill-color! context "#ffffff")
(set-font! context "normal 16px monogram") (set-text-align! context "center")
(fill-text context "keyboard:" (set-font! context "normal 16px monogram")
cx1 (- baseline 32.0)) (fill-text context "keyboard:"
(fill-text context "arrows -> move" cx1 (- baseline 32.0))
cx1 (- baseline 16.0)) (fill-text context "arrows -> move"
(fill-text context "Z -> undo" cx1 (- baseline 16.0))
cx1 baseline) (fill-text context "Z -> undo"
(fill-text context "touchscreen:" cx1 baseline)
cx2 (- baseline 32.0)) (fill-text context "touchscreen:"
(fill-text context "dpad -> move" cx2 (- baseline 32.0))
cx2 (- baseline 16.0)) (fill-text context "dpad -> move"
(fill-text context "A -> undo" cx2 (- baseline 16.0))
cx2 baseline)))) (fill-text context "A -> undo"
('win (draw-win))) cx2 baseline)))
(if (current-menu) (draw-menu)) (when (eq? 'menu state)
(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,31 +1022,32 @@
(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 ('play
('up (menu-up!)) (match input
('down (menu-down!)) ('left (move-player 'left))
('confirm (menu-select!)) ('right (move-player 'right))
('menu (hide-menu!))) ('up (move-player 'up))
(match *state* ('down (move-player 'down))
('play ('undo
(match input (rollback-snapshot!)
('left (move-player 'left)) (with-goblins (update-objects!)))
('right (move-player 'right))
('up (move-player 'up))
('down (move-player 'down))
('undo
(rollback-snapshot!)
(with-goblins (update-objects!)))
;; REMOVE BEFORE RELEASE!!!! ;; REMOVE BEFORE RELEASE!!!!
;; ('confirm (next-level!)) ;; ('confirm (next-level!))
('menu (show-menu!)))) ('menu (show-menu!))))
;; Pressing any bound input resets the game. ('menu
('win (if *level-last* (match input
(begin ('up (menu-up!))
(load-level! *level-last*) ('down (menu-down!))
(set! *level-last* #f)) ('confirm (menu-select!))
(reset-game!)))))) ('menu (hide-menu!))
(_ #f)))
;; Pressing any bound input resets the game.
('win (if *level-last*
(begin
(load-level! *level-last*)
(set! *level-last* #f))
(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"))