Created game state history
This commit is contained in:
parent
0e5fc5a73b
commit
a42d5c5656
1 changed files with 89 additions and 77 deletions
92
game.scm
92
game.scm
|
@ -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"))
|
||||||
|
|
Loading…
Add table
Reference in a new issue