Use the new scene/stage API.

3 files changed, 45 insertions, 224 deletions

diff --git a/2d/game-loop.scm b/2d/game-loop.scm
index d8075f8..b55c383 100644
--- a/2d/game-loop.scm
+++ b/2d/game-loop.scm
@@ -29,15 +29,13 @@
   #:use-module (figl gl)
   #:use-module (2d agenda)
   #:use-module (2d coroutine)
-  #:use-module (2d private game)
+  #:use-module (2d game)
+  #:use-module (2d mvars)
   #:use-module (2d repl server)
   #:use-module (2d repl repl)
-  #:use-module (2d mvars)
+  #:use-module (2d stage)
   #:use-module (2d window)
   #:export (current-fps
-            push-scene
-            replace-scene
-            pop-scene
             run-game
             quit-game
             pause-game
@@ -58,37 +56,38 @@
 
 (define handle-events
   (let ((e (SDL:make-event)))
-    (lambda (scene)
+    (lambda (stage)
       "Handle all events in the SDL event queue."
       (while (SDL:poll-event e)
-        (handle-event scene e)))))
+        (handle-event stage e)))))
 
-(define (handle-event scene e)
+(define (handle-event stage e)
   "Call the relevant callbacks for the event, E."
   (case (SDL:event:type e)
     ((active)
-     (scene-trigger scene 'active))
+     (stage-trigger stage 'active))
     ((video-resize)
-     (scene-trigger scene
+     (stage-trigger stage
                     'resize
                     (SDL:event:resize:w e)
                     (SDL:event:resize:h e)))
     ((quit)
-     (scene-trigger scene 'quit))
+     (quit-game)
+     (stage-trigger stage 'quit))
     ((key-down)
-     (scene-trigger scene
+     (stage-trigger stage
                     'key-down
                     (SDL:event:key:keysym:sym e)
                     (SDL:event:key:keysym:mod e)
                     (SDL:event:key:keysym:unicode e)))
     ((key-up)
-     (scene-trigger scene
+     (stage-trigger stage
                     'key-up
                     (SDL:event:key:keysym:sym e)
                     (SDL:event:key:keysym:mod e)
                     (SDL:event:key:keysym:unicode e)))
     ((mouse-motion)
-     (scene-trigger scene
+     (stage-trigger stage
                     'mouse-motion
                     (SDL:event:motion:state e)
                     (SDL:event:motion:x e)
@@ -96,13 +95,13 @@
                     (SDL:event:motion:xrel e)
                     (SDL:event:motion:yrel e)))
     ((mouse-button-down)
-     (scene-trigger scene
+     (stage-trigger stage
                     'mouse-press
                     (SDL:event:button:button e)
                     (SDL:event:button:x e)
                     (SDL:event:button:y e)))
     ((mouse-button-up)
-     (scene-trigger scene
+     (stage-trigger stage
                     'mouse-click
                     (SDL:event:button:button e)
                     (SDL:event:button:x e)
@@ -139,25 +138,25 @@ second."
 ;;; Update and Render
 ;;;
 
-(define (render scene dt)
+(define (render stage dt)
   "Render a frame."
   (set-gl-matrix-mode (matrix-mode modelview))
   (gl-load-identity)
   (gl-clear (clear-buffer-mask color-buffer depth-buffer))
-  (draw-scene scene)
+  (draw-stage stage)
   (SDL:gl-swap-buffers)
   (accumulate-fps! dt))
 
-(define (update scene accumulator)
+(define (update stage accumulator)
   "Call the update callback. The update callback will be called as
 many times as `tick-interval` can divide ACCUMULATOR. The return value
 is the unused accumulator time."
   (if (>= accumulator tick-interval)
       (begin
-        (handle-events scene)
+        (handle-events stage)
         (update-agenda)
-        (update-scene scene)
-        (update scene (- accumulator tick-interval)))
+        (update-stage stage)
+        (update stage (- accumulator tick-interval)))
       accumulator))
 
 ;;;
@@ -185,40 +184,6 @@ INPUT, OUTPUT, and ERROR ports."
               (apply run-repl-thunk vals))))
 
 ;;;
-;;; Scene management
-;;;
-
-(define scenes '())
-
-(define (current-scene)
-  (car scenes))
-
-(define (push-scene scene)
-  "Pause the current scene and start SCENE upon next game tick."
-  (set! scenes (cons scene scenes)))
-
-(define (replace-scene scene)
-  (set! scenes (cons scene (cdr scenes))))
-
-(define (pop-scene)
-  "Exit the current scene and resume the previous scene. If there is
-no previous scene, the game loop will terminate."
-  (if (null? scenes)
-      (quit-game)
-      (set! scenes (cdr scenes))))
-
-(define (switch-scenes-maybe scene)
-  "Switch scenes if the current scene is not the scene at the top of
-the stack."
-  (unless (eq? scene (current-scene))
-    (scene-trigger scene 'stop)
-    (scene-trigger (current-scene) 'start)))
-
-(define (set-initial-scene scene)
-  (set! scenes (list scene))
-  (scene-trigger scene 'start))
-
-;;;
 ;;; Game Loop
 ;;;
 
@@ -234,11 +199,10 @@ the stack."
         accumulator)
       (catch #t
         (lambda ()
-          (let* ((scene (current-scene))
-                 (remainder (update scene accumulator)))
+          (let* ((stage (current-stage))
+                 (remainder (update stage accumulator)))
             (run-repl)
-            (render scene dt)
-            (switch-scenes-maybe scene)
+            (render stage dt)
             remainder))
         (lambda (key . args)
           (pause-game)
@@ -259,12 +223,13 @@ time in milliseconds that has passed since the last game update."
 
 (define (run-game game)
   "Open a window and start the game loop for GAME."
+  (pk 'game game)
   (open-window (game-title game)
                (game-resolution game)
                (game-fullscreen? game))
   (set! running? #t)
   (resume-game)
-  (set-initial-scene ((game-first-scene game)))
+  (push-stage (make-stage (game-first-scene game)))
   (spawn-server)
   (game-loop (SDL:get-ticks) 0)
   (close-window))
diff --git a/2d/game.scm b/2d/game.scm
index 4c58521..4c91b1b 100644
--- a/2d/game.scm
+++ b/2d/game.scm
@@ -22,92 +22,35 @@
 ;;; Code:
 
 (define-module (2d game)
-  #:use-module (2d private game)
-  #:use-module (2d game-loop)
+  #:use-module (srfi srfi-9)
   #:use-module (2d helpers)
   #:use-module (2d observer)
-  #:use-module (2d vector2))
-
-;;;
-;;; Scenes
-;;;
-
-;; When no event callbacks are specified for a scene, these
-;; (hopefully) convenient defaults will be used.
-(define %default-scene-events
-  `((quit     . ,(lambda (state) (quit-game)))
-    (key-down . ,(lambda (state key mode unicode)
-                   (when (any-equal? key 'escape 'q)
-                     (quit-game))))))
-
-(define (default-scene-events)
-  (copy-tree %default-scene-events))
-
-(define* (make-scene #:optional #:key
-                     (title "A Guile-2D Scene")
-                     (events (default-scene-events))
-                     (update (lambda (s) #f))
-                     (draw (lambda (s) #f))
-                     (state #f))
-  "Return a new scene. TITLE is a human readable name for the
-scene. EVENTS is an alist of event handlers. UPDATE is a procedure
-that updates the scene. DRAW is a procedure that renders the
-scene. STATE is an object that encapsulates the scene state."
-  (%make-scene title (alist->observer events) update draw state))
-
-(define-syntax-rule (define-scene name kwargs ...)
-  "Syntactic sugar over define and make-scene. Return a procedure that
-creates a new scene."
-  (define (name) (make-scene kwargs ...)))
-
-(re-export <scene>
-           scene?
-           scene-title
-           scene-observer
-           scene-update-proc
-           scene-draw-proc
-           scene-state
-           scene-trigger
-           update-scene
-           draw-scene
-           push-scene
-           replace-scene
-           pop-scene)
-
-(export make-scene
-        define-scene
-        default-scene-events)
+  #:use-module (2d vector2)
+  #:export (<game>
+            make-game
+            game?
+            game-title
+            game-resolution
+            game-fullscreen?
+            game-first-scene))
 
 ;;;
 ;;; Games
 ;;;
 
+(define-record-type <game>
+  (%make-game title resolution fullscreen? first-scene)
+  game?
+  (title game-title)
+  (resolution game-resolution)
+  (fullscreen? game-fullscreen?)
+  (first-scene game-first-scene))
+
 (define* (make-game #:optional #:key
                     (title "A Guile-2D Game")
                     (resolution (vector2 640 480))
-                    (fullscreen #f)
+                    (fullscreen? #f)
                     (first-scene #f))
   "Return a new game. All game properties have some reasonable default
 value."
-  (%make-game title resolution fullscreen first-scene))
-
-(define-syntax-rule (define-game name kwargs ...)
-  "Syntactic sugar over define and make-game."
-  (define name (make-game kwargs ...)))
-
-(re-export <game>
-           game?
-           game-title
-           game-resolution
-           game-fullscreen?
-           game-first-scene
-           run-game
-           quit-game
-           pause-game
-           resume-game
-           game-running?
-           game-paused?
-           current-fps)
-
-(export make-game
-        define-game)
+  (%make-game title resolution fullscreen? first-scene))
diff --git a/2d/private/game.scm b/2d/private/game.scm
deleted file mode 100644
index 88a971f..0000000
--- a/2d/private/game.scm
+++ /dev/null
@@ -1,87 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; Guile-2d is free software: you can redistribute it and/or modify it
-;;; under the terms of the GNU Lesser General Public License as
-;;; published by the Free Software Foundation, either version 3 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; Guile-2d is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; Lesser General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with this program.  If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Game data structure.
-;;
-;;; Code:
-
-(define-module (2d private game)
-  #:use-module (srfi srfi-9)
-  #:use-module (2d observer))
-
-;;;
-;;; Scenes
-;;;
-
-(define-record-type <scene>
-  (%make-scene title observer update-proc draw-proc state)
-  scene?
-  (title scene-title)
-  (observer scene-observer)
-  (update-proc scene-update-proc)
-  (draw-proc scene-draw-proc)
-  (state scene-state))
-
-(define (scene-trigger scene event-type . args)
-  "Trigger an event on the scene observer."
-  (apply observer-trigger
-         (scene-observer scene)
-         event-type
-         (scene-state scene)
-         args))
-
-(define (draw-scene scene)
-  "Draw SCENE."
-  ((scene-draw-proc scene) (scene-state scene)))
-
-(define (update-scene scene)
-  "Update SCENE."
-  ((scene-update-proc scene) (scene-state scene)))
-
-(export <scene>
-        %make-scene
-        scene?
-        scene-title
-        scene-observer
-        scene-update-proc
-        scene-draw-proc
-        scene-state
-        scene-trigger
-        update-scene
-        draw-scene)
-
-;;;
-;;; Games
-;;;
-
-(define-record-type <game>
-  (%make-game title resolution fullscreen first-scene)
-  game?
-  (title game-title)
-  (resolution game-resolution)
-  (fullscreen game-fullscreen?)
-  (first-scene game-first-scene))
-
-(export <game>
-        %make-game
-        game?
-        game-title
-        game-resolution
-        game-fullscreen?
-        game-first-scene)