Add event observer to scene.

Some convenient default events are provided to make quitting the game
easy for new developers.

3 files changed, 92 insertions, 75 deletions

diff --git a/2d/game-loop.scm b/2d/game-loop.scm
index 39fde9e..79e09b7 100644
--- a/2d/game-loop.scm
+++ b/2d/game-loop.scm
@@ -33,6 +33,7 @@
   #:use-module (2d mvars)
   #:use-module (2d repl server)
   #:use-module (2d repl repl)
+  #:use-module (2d scene)
   #:use-module (2d stage)
   #:use-module (2d window)
   #:export (current-fps
@@ -44,6 +45,74 @@
             game-paused?))
 
 ;;;
+;;; Game Loop
+;;;
+
+(define running? #f)
+(define paused? #f)
+
+(define (tick dt accumulator)
+  "Advance the game by one frame."
+  (if paused?
+      (begin
+        (run-repl)
+        (SDL:delay tick-interval)
+        accumulator)
+      (catch #t
+        (lambda ()
+          (let* ((stage (current-stage))
+                 (remainder (update stage accumulator)))
+            (run-repl)
+            (render stage dt)
+            remainder))
+        (lambda (key . args)
+          (pause-game)
+          accumulator)
+        (lambda (key . args)
+          (display-backtrace (make-stack #t)
+                             (current-output-port))))))
+
+(define (game-loop last-time accumulator)
+  "Update game state, and render. LAST-TIME is the time in
+milliseconds of the last iteration of the loop. ACCUMULATOR is the
+time in milliseconds that has passed since the last game update."
+  (when running?
+    (let* ((current-time (SDL:get-ticks))
+           (dt (- current-time last-time))
+           (accumulator (+ accumulator dt)))
+      (game-loop current-time (tick dt accumulator)))))
+
+(define (run-game game)
+  "Open a window and start the game loop for GAME."
+  (open-window (game-title game)
+               (game-resolution game)
+               (game-fullscreen? game))
+  (set! running? #t)
+  (resume-game)
+  (push-scene (game-first-scene game))
+  (spawn-server)
+  (game-loop (SDL:get-ticks) 0)
+  (close-window))
+
+(define (game-running?)
+  (running?))
+
+(define (game-paused?)
+  (paused?))
+
+(define (pause-game)
+  "Pauses the game loop. Useful when developing."
+  (set! paused? #t))
+
+(define (resume-game)
+  "Resumes the game loop."
+  (set! paused? #f))
+
+(define (quit-game)
+  "Finish the current frame and terminate the game loop."
+  (set! running? #f))
+
+;;;
 ;;; Constants
 ;;;
 
@@ -54,6 +123,12 @@
 ;;; Event Handling
 ;;;
 
+;; By default, pressing the escape key will pop the current scene, and
+;; closing the window will quit the game.
+(default-events `((key-down . ,(lambda (key mod unicode)
+                                 (pop-scene)))
+                  (quit . ,quit-game)))
+
 (define handle-events
   (let ((e (SDL:make-event)))
     (lambda (stage)
@@ -72,7 +147,6 @@
                     (SDL:event:resize:w e)
                     (SDL:event:resize:h e)))
     ((quit)
-     (quit-game)
      (stage-trigger stage 'quit))
     ((key-down)
      (stage-trigger stage
@@ -182,71 +256,3 @@ INPUT, OUTPUT, and ERROR ports."
   (unless (mvar-empty? repl-input-mvar)
     (and-let* ((vals (try-take-mvar repl-input-mvar)))
               (apply run-repl-thunk vals))))
-
-;;;
-;;; Game Loop
-;;;
-
-(define running? #f)
-(define paused? #f)
-
-(define (tick dt accumulator)
-  "Advance the game by one frame."
-  (if paused?
-      (begin
-        (run-repl)
-        (SDL:delay tick-interval)
-        accumulator)
-      (catch #t
-        (lambda ()
-          (let* ((stage (current-stage))
-                 (remainder (update stage accumulator)))
-            (run-repl)
-            (render stage dt)
-            remainder))
-        (lambda (key . args)
-          (pause-game)
-          accumulator)
-        (lambda (key . args)
-          (display-backtrace (make-stack #t)
-                             (current-output-port))))))
-
-(define (game-loop last-time accumulator)
-  "Update game state, and render. LAST-TIME is the time in
-milliseconds of the last iteration of the loop. ACCUMULATOR is the
-time in milliseconds that has passed since the last game update."
-  (when running?
-    (let* ((current-time (SDL:get-ticks))
-           (dt (- current-time last-time))
-           (accumulator (+ accumulator dt)))
-      (game-loop current-time (tick dt accumulator)))))
-
-(define (run-game game)
-  "Open a window and start the game loop for GAME."
-  (open-window (game-title game)
-               (game-resolution game)
-               (game-fullscreen? game))
-  (set! running? #t)
-  (resume-game)
-  (push-scene (game-first-scene game))
-  (spawn-server)
-  (game-loop (SDL:get-ticks) 0)
-  (close-window))
-
-(define (game-running?)
-  (running?))
-
-(define (game-paused?)
-  (paused?))
-
-(define (pause-game)
-  "Pauses the game loop. Useful when developing."
-  (set! paused? #t))
-
-(define (resume-game)
-  "Resumes the game loop."
-  (set! paused? #f))
-
-(define (quit-game)
-  "Finish the current frame and terminate the game loop."
-  (set! running? #f))
diff --git a/2d/scene.scm b/2d/scene.scm
index 076897a..7415f80 100644
--- a/2d/scene.scm
+++ b/2d/scene.scm
@@ -23,6 +23,7 @@
 
 (define-module (2d scene)
   #:use-module (srfi srfi-9)
+  #:use-module (2d observer)
   #:export (<scene>
             make-scene
             scene?
@@ -32,23 +33,28 @@
             scene-exit
             scene-draw
             scene-update
+            scene-observer
             init-scene
             enter-scene
             exit-scene
             draw-scene
-            update-scene))
+            update-scene
+            scene-trigger
+            default-events))
 
 (define-record-type <scene>
-  (%make-scene name init enter exit draw update)
+  (%make-scene name init enter exit draw update observer)
   scene?
   (name scene-name)
   (init scene-init)
   (enter scene-enter)
   (exit scene-exit)
   (draw scene-draw)
-  (update scene-update))
+  (update scene-update)
+  (observer scene-observer))
 
 (define no-op (lambda args #f))
+(define default-events (make-parameter '()))
 
 (define* (make-scene name
                      #:optional #:key
@@ -56,9 +62,11 @@
                      (enter no-op)
                      (exit no-op)
                      (draw no-op)
-                     (update no-op))
+                     (update no-op)
+                     (events (default-events)))
   "Create a new scene object. All callbacks default to a no-op."
-  (%make-scene name init enter exit draw update))
+  (%make-scene name init enter exit draw update
+               (alist->observer events)))
 
 (define (init-scene scene)
   "Return the value returned by the state constructor thunk for
@@ -80,3 +88,6 @@ SCENE."
 (define (update-scene scene state)
   "Call the update callback for SCENE with STATE."
   ((scene-update scene) state))
+
+(define (scene-trigger scene event . args)
+  (apply observer-trigger (scene-observer scene) event args))
diff --git a/2d/stage.scm b/2d/stage.scm
index 27b29ba..fee18a3 100644
--- a/2d/stage.scm
+++ b/2d/stage.scm
@@ -87,7 +87,7 @@
 
 (define (stage-trigger stage event . args)
   (with-agenda (stage-agenda stage)
-    #f))
+    (apply scene-trigger (stage-scene stage) event args)))
 
 ;;;
 ;;; Stage management