Created game state history

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?
@@ -330,22 +320,41 @@
         ((= i (vector-length levels)))
       (vector-set! items i (make-menu-item (string-append "Level " (number->string 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,8 +905,9 @@
     (scale! context *canvas-scale* *canvas-scale*)
     (draw-current-effect 'pre)
 
-    (match *state*
+    (let ((state (current-game-state)))
-      ((or 'play 'interstitial)
+      (match state
+        ((or 'menu 'play 'interstitial)
          (draw-level)
          ;; Display input mappings on the title screen/first level.
          (when (= *level-idx* 0)
@@ -918,9 +928,10 @@
              (fill-text context "dpad -> move"
                         cx2 (- baseline 16.0))
              (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)
     (request-animation-frame draw-callback)))
 (define draw-callback (procedure->external draw))
@@ -1011,13 +1022,7 @@
              (on-input-down 'undo))))))))
 
 (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
      (match input
        ('left (move-player 'left))
@@ -1030,12 +1035,19 @@
            ;; REMOVE BEFORE RELEASE!!!!
        ;; ('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!))))))
+              (reset-game!)))))
 
 ;; Canvas and event loop setup
 (define canvas (get-element-by-id "canvas"))