diff --git a/game.scm b/game.scm index 60756e6..a15d09b 100644 --- a/game.scm +++ b/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 (_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"))