Created game state history
This commit is contained in:
Amy Grinn
parent
0e5fc5a73b
commit
a42d5c5656
1 changed files with 89 additions and 77 deletions
166
game.scm
166
game.scm
|
|
@ -106,7 +106,16 @@
|
|||
(define audio:bg-music (load-music "cirkoban"))
|
||||
|
||||
;; 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 (call-with-goblins thunk)
|
||||
|
|
@ -205,7 +214,7 @@
|
|||
(memq idx *gems*))
|
||||
|
||||
(define (set-level! idx)
|
||||
(set! *state* 'play)
|
||||
(push-game-state! 'play)
|
||||
(set! *actormap* (make-whactormap))
|
||||
(clear-snapshots!)
|
||||
(with-goblins
|
||||
|
|
@ -213,7 +222,7 @@
|
|||
(update-objects!)))
|
||||
|
||||
(define (load-credits!)
|
||||
(set! *state* 'win)
|
||||
(push-game-state! 'win)
|
||||
(set! *actormap* (make-whactormap))
|
||||
(set-vec2-y! *credits-scroll* 0.0)
|
||||
(clear-snapshots!)
|
||||
|
|
@ -230,7 +239,7 @@
|
|||
(begin
|
||||
(run-script
|
||||
(lambda ()
|
||||
(set! *state* 'interstitial)
|
||||
(push-game-state! 'interstitial)
|
||||
(yield
|
||||
(lambda (k)
|
||||
(show-effect! (make-fade-out+in-effect 1.0 k))))
|
||||
|
|
@ -240,7 +249,7 @@
|
|||
(begin
|
||||
(run-script
|
||||
(lambda ()
|
||||
(set! *state* 'interstitial)
|
||||
(push-game-state! 'interstitial)
|
||||
(yield
|
||||
(lambda (k)
|
||||
(show-effect! (make-fade-out+in-effect 2.0 k))))
|
||||
|
|
@ -292,25 +301,6 @@
|
|||
(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>
|
||||
(_make-menu-item name type payload)
|
||||
menu-item?
|
||||
|
|
@ -329,23 +319,42 @@
|
|||
(do ((i 0 (1+ i)))
|
||||
((= i (vector-length levels)))
|
||||
(vector-set! items i (make-menu-item (string-append "Level " (number->string i))
|
||||
'level i)))
|
||||
|
||||
'level 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))))
|
||||
|
||||
(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
|
||||
(define* (show-menu! #:optional menu)
|
||||
(push-game-state! 'menu)
|
||||
(set-menu! (or menu menu:main))
|
||||
(set-menu-index! -1)
|
||||
(set-menu-page! 0)
|
||||
(set-menu-history! '()))
|
||||
|
||||
(define (hide-menu!)
|
||||
(set-menu! #f))
|
||||
(pop-game-state!))
|
||||
|
||||
(define (menu-up!)
|
||||
(set-menu-index! (max -1 (1- (current-menu-index))))
|
||||
|
|
@ -393,7 +402,7 @@
|
|||
(define (reset-game!)
|
||||
(run-script
|
||||
(lambda ()
|
||||
(set! *state* 'interstitial)
|
||||
(push-game-state! 'interstitial)
|
||||
(yield
|
||||
(lambda (k)
|
||||
(show-effect! (make-fade-out+in-effect 2.0 k))))
|
||||
|
|
@ -896,31 +905,33 @@
|
|||
(scale! context *canvas-scale* *canvas-scale*)
|
||||
(draw-current-effect 'pre)
|
||||
|
||||
(match *state*
|
||||
((or 'play 'interstitial)
|
||||
(draw-level)
|
||||
;; Display input mappings on the title screen/first level.
|
||||
(when (= *level-idx* 0)
|
||||
(let ((cx1 (/ game-width 4.0))
|
||||
(cx2 (* game-width 0.75))
|
||||
(baseline (/ game-height 2.0)))
|
||||
(set-fill-color! context "#ffffff")
|
||||
(set-text-align! context "center")
|
||||
(set-font! context "normal 16px monogram")
|
||||
(fill-text context "keyboard:"
|
||||
cx1 (- baseline 32.0))
|
||||
(fill-text context "arrows -> move"
|
||||
cx1 (- baseline 16.0))
|
||||
(fill-text context "Z -> undo"
|
||||
cx1 baseline)
|
||||
(fill-text context "touchscreen:"
|
||||
cx2 (- baseline 32.0))
|
||||
(fill-text context "dpad -> move"
|
||||
cx2 (- baseline 16.0))
|
||||
(fill-text context "A -> undo"
|
||||
cx2 baseline))))
|
||||
('win (draw-win)))
|
||||
(if (current-menu) (draw-menu))
|
||||
(let ((state (current-game-state)))
|
||||
(match state
|
||||
((or 'menu 'play 'interstitial)
|
||||
(draw-level)
|
||||
;; Display input mappings on the title screen/first level.
|
||||
(when (= *level-idx* 0)
|
||||
(let ((cx1 (/ game-width 4.0))
|
||||
(cx2 (* game-width 0.75))
|
||||
(baseline (/ game-height 2.0)))
|
||||
(set-fill-color! context "#ffffff")
|
||||
(set-text-align! context "center")
|
||||
(set-font! context "normal 16px monogram")
|
||||
(fill-text context "keyboard:"
|
||||
cx1 (- baseline 32.0))
|
||||
(fill-text context "arrows -> move"
|
||||
cx1 (- baseline 16.0))
|
||||
(fill-text context "Z -> undo"
|
||||
cx1 baseline)
|
||||
(fill-text context "touchscreen:"
|
||||
cx2 (- baseline 32.0))
|
||||
(fill-text context "dpad -> move"
|
||||
cx2 (- baseline 16.0))
|
||||
(fill-text context "A -> undo"
|
||||
cx2 baseline)))
|
||||
(when (eq? 'menu state)
|
||||
(draw-menu)))
|
||||
('win (draw-win))))
|
||||
(draw-current-effect 'post)
|
||||
(request-animation-frame draw-callback)))
|
||||
(define draw-callback (procedure->external draw))
|
||||
|
|
@ -1011,31 +1022,32 @@
|
|||
(on-input-down 'undo))))))))
|
||||
|
||||
(define (on-input-down input)
|
||||
(if (current-menu)
|
||||
(match input
|
||||
('up (menu-up!))
|
||||
('down (menu-down!))
|
||||
('confirm (menu-select!))
|
||||
('menu (hide-menu!)))
|
||||
(match *state*
|
||||
('play
|
||||
(match input
|
||||
('left (move-player 'left))
|
||||
('right (move-player 'right))
|
||||
('up (move-player 'up))
|
||||
('down (move-player 'down))
|
||||
('undo
|
||||
(rollback-snapshot!)
|
||||
(with-goblins (update-objects!)))
|
||||
(match (current-game-state)
|
||||
('play
|
||||
(match input
|
||||
('left (move-player 'left))
|
||||
('right (move-player 'right))
|
||||
('up (move-player 'up))
|
||||
('down (move-player 'down))
|
||||
('undo
|
||||
(rollback-snapshot!)
|
||||
(with-goblins (update-objects!)))
|
||||
;; REMOVE BEFORE RELEASE!!!!
|
||||
;; ('confirm (next-level!))
|
||||
('menu (show-menu!))))
|
||||
;; Pressing any bound input resets the game.
|
||||
('win (if *level-last*
|
||||
(begin
|
||||
(load-level! *level-last*)
|
||||
(set! *level-last* #f))
|
||||
(reset-game!))))))
|
||||
;; ('confirm (next-level!))
|
||||
('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.
|
||||
('win (if *level-last*
|
||||
(begin
|
||||
(load-level! *level-last*)
|
||||
(set! *level-last* #f))
|
||||
(reset-game!)))))
|
||||
|
||||
;; Canvas and event loop setup
|
||||
(define canvas (get-element-by-id "canvas"))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue