Add a *running* flag to the game loop.

3 files changed, 47 insertions, 43 deletions

diff --git a/2d/game-loop.scm b/2d/game-loop.scm
index ab81b5a..8dcc65c 100644
--- a/2d/game-loop.scm
+++ b/2d/game-loop.scm
@@ -42,8 +42,9 @@
             on-mouse-motion-hook
             on-mouse-button-down-hook
             on-mouse-button-up-hook
+            current-fps
             run-game-loop
-            current-fps))
+            quit-game-loop!))
 
 ;;;
 ;;; Constants
@@ -57,6 +58,7 @@
 ;;;
 
 (define *fps* 0)
+(define *running* #f)
 
 ;;;
 ;;; Hooks
@@ -200,23 +202,30 @@ INPUT, OUTPUT, and ERROR ports."
 
 (define (game-loop last-time next-time accumulator)
   "Runs input, render, and update hooks."
-  (handle-events)
-  (let* ((time (SDL:get-ticks))
-         (dt (- time last-time))
-         (accumulator (+ accumulator dt))
-         (remainder (update accumulator)))
-    (run-repl)
-    (render)
-    (accumulate-fps! dt)
-    (SDL:delay (time-left (SDL:get-ticks) next-time))
-    (game-loop time
-               (+ next-time tick-interval)
-               remainder)))
+  (when *running*
+    (handle-events)
+    (let* ((time (SDL:get-ticks))
+           (dt (- time last-time))
+           (accumulator (+ accumulator dt))
+           (remainder (update accumulator)))
+      (run-repl)
+      (render)
+      (accumulate-fps! dt)
+      (SDL:delay (time-left (SDL:get-ticks) next-time))
+      (game-loop time
+                 (+ next-time tick-interval)
+                 remainder))))
 
 (define (run-game-loop)
   "Spawns a REPL server and starts the main game loop."
+  (set! *running* #t)
   (spawn-server)
   ;;(lock-mutex game-loop-mutex)
   (agenda-schedule show-fps)
   (let ((time (SDL:get-ticks)))
     (game-loop time (+ time tick-interval) 0)))
+
+(define (quit-game-loop!)
+  "Tell the game loop to finish up the current frame and then
+terminate."
+  (set! *running* #f))
diff --git a/2d/game.scm b/2d/game.scm
index e20638c..cb043ec 100644
--- a/2d/game.scm
+++ b/2d/game.scm
@@ -25,16 +25,11 @@
   #:use-module (srfi srfi-9)
   #:use-module (2d game-loop)
   #:use-module (2d window)
-  #:use-module (2d vector2)
-  #:export (<game>
-            make-game
-            define-game
-            game?
-            game-title
-            game-resolution
-            game-fullscreen?
-            game-first-scene
-            run-game))
+  #:use-module (2d vector2))
+
+;;;
+;;; Games
+;;;
 
 (define-record-type <game>
   (%make-game title resolution fullscreen first-scene)
@@ -64,3 +59,13 @@ value."
                (game-fullscreen? game))
   (run-game-loop)
   (close-window))
+
+(export <game>
+        make-game
+        define-game
+        game?
+        game-title
+        game-resolution
+        game-fullscreen?
+        game-first-scene
+        run-game)
diff --git a/examples/simple.scm b/examples/simple.scm
index 6a4e928..c33b7a2 100644
--- a/examples/simple.scm
+++ b/examples/simple.scm
@@ -1,38 +1,28 @@
 (use-modules (2d sprite)
+             (2d game)
              (2d game-loop)
-             (2d window)
              (2d helpers)
              (2d vector2))
 
-(define window-width 800)
-(define window-height 600)
-
-;; Open the window.
-(open-window window-width window-height)
-
 (define sprite
-  (load-sprite "images/sprite.png"
-               #:position (vector2 (/ window-width 2)
-                                   (/ window-height 2))))
-
-(define (quit-demo)
-  (close-window)
-  (quit))
+  (delay (load-sprite "images/sprite.png"
+                      #:position (vector2 320 240))))
 
 (define (key-down key mod unicode)
   (cond ((any-equal? key 'escape 'q)
-         (quit-demo))))
+         (quit-game-loop!))))
 
 ;; Draw our sprite
 (define (render)
-  (draw-sprite sprite))
+  (draw-sprite (force sprite)))
 
 ;; Register callbacks.
 (add-hook! on-quit-hook (lambda () (quit-demo)))
 (add-hook! on-render-hook (lambda () (render)))
-(add-hook! on-key-down-hook (lambda (key mod unicode) (key-down key mod unicode)))
+(add-hook! on-key-down-hook (lambda (key mod unicode)
+                              (key-down key mod unicode)))
 
+(define-game simple
+  #:title "Simple Demo")
 
-;; Start the game loop.
-;; The render callback will be called through this procedure.
-(run-game-loop)
+(run-game simple)