Make the game loop modular!

This is really cool!  Now users can plug in whatever backend they'd
like and are not forced to use SDL and OpenGL.  Thanks to Chris Webber
for showing me the Lux library for Racket that does exactly this.

* chickadee.scm (run-game): Remove all SDL/OpenGL code, replace with
generic render/update keyword arguments.
(run-game/sdl): New procedure.
* examples/lines.scm: Update for API breakage.
* examples/nine-patch.scm: Ditto.
* examples/sprite.scm: Ditto.
* examples/text.scm: Ditto.
* examples/tiled.scm: Ditto.

1 files changed, 182 insertions, 179 deletions

diff --git a/chickadee.scm b/chickadee.scm
index e2a705f..eb98443 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -1,5 +1,5 @@
 ;;; Chickadee Game Toolkit
-;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2018 David Thompson <davet@gnu.org>
 ;;;
 ;;; Chickadee is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published
@@ -27,52 +27,14 @@
   #:use-module (chickadee render gl)
   #:use-module (chickadee render gpu)
   #:use-module (chickadee render viewport)
-  #:export (load-hook
-            update-hook
-            before-draw-hook
-            draw-hook
-            after-draw-hook
-            quit-hook
-            key-press-hook
-            key-release-hook
-            text-input-hook
-            mouse-press-hook
-            mouse-release-hook
-            mouse-move-hook
-            controller-add-hook
-            controller-remove-hook
-            controller-press-hook
-            controller-release-hook
-            controller-move-hook
-            error-hook
-            run-game
+  #:export (run-game*
             abort-game
-            time))
-
-(define load-hook (make-hook 0))
-(define update-hook (make-hook 1))
-(define before-draw-hook (make-hook 0))
-(define after-draw-hook (make-hook 0))
-(define draw-hook (make-hook 1))
-(define quit-hook (make-hook 0))
-(define key-press-hook (make-hook 4))
-(define key-release-hook (make-hook 3))
-(define text-input-hook (make-hook 1))
-(define mouse-press-hook (make-hook 4))
-(define mouse-release-hook (make-hook 3))
-(define mouse-move-hook (make-hook 5))
-(define controller-add-hook (make-hook 1))
-(define controller-remove-hook (make-hook 1))
-(define controller-press-hook (make-hook 2))
-(define controller-release-hook (make-hook 2))
-(define controller-move-hook (make-hook 3))
-(define error-hook (make-hook 3))
+            run-game/sdl))
 
-(define open-controller (@@ (chickadee input controller) open-controller))
-(define close-controller (@@ (chickadee input controller) close-controller))
-(define lookup-controller (@@ (chickadee input controller) lookup-controller))
-
-(define game-loop-prompt-tag (make-prompt-tag 'game-loop))
+
+;;;
+;;; Error handling
+;;;
 
 (define (display-game-loop-error stack key args)
   (let ((port (current-error-port)))
@@ -82,149 +44,190 @@
     (apply display-error (stack-ref stack 0) port args)
     (newline port)))
 
-(define (call-with-error-handling thunk)
-  (if (hook-empty? error-hook)
-      (thunk)
-      (let ((stack #f))
-        (catch #t
-          thunk
-          (lambda (key . args)
-            (display-game-loop-error stack key args)
-            (run-hook error-hook stack key args))
-          (lambda (key . args)
-            (set! stack (make-stack #t 3)))))))
-
-(define-syntax-rule (run-hook* args ...)
-  (call-with-error-handling
-   (lambda ()
-     (run-hook args ...))))
-
-(define* (run-game #:key
-                   (window-title "Chickadee!")
-                   (window-width 640)
-                   (window-height 480)
-                   window-fullscreen?
-                   (update-hz 60))
+(define (call-with-error-handling handler thunk)
+  (let ((stack #f))
+    (catch #t
+      thunk
+      (lambda (key . args)
+        (display-game-loop-error stack key args)
+        (error stack key args))
+      (lambda (key . args)
+        (set! stack (make-stack #t 3))))))
+
+(define-syntax-rule (with-error-handling handler body ...)
+  (call-with-error-handling handler  (lambda () body ...)))
+
+
+;;;
+;;; Game loop core
+;;;
+
+(define game-loop-prompt-tag (make-prompt-tag 'game-loop))
+
+(define (abort-game)
+  (abort-to-prompt game-loop-prompt-tag #f))
+
+(define* (run-game #:key update render time error (update-hz 60))
+  (let ((timestep (round (/ 1000 update-hz))))
+    (call-with-prompt game-loop-prompt-tag
+      (lambda ()
+        ;; Catch SIGINT and kill the loop.
+        (sigaction SIGINT
+          (lambda (signum)
+            (abort-game)))
+        ;; A simple analogy is that we are filling up a bucket
+        ;; with water.  When the bucket fills up to a marked
+        ;; line, we dump it out.  Our water is time, and each
+        ;; time we dump the bucket we update the game.  Updating
+        ;; the game on a fixed timestep like this yields a
+        ;; stable simulation.
+        (let loop ((previous-time (time))
+                   (buffer 0))
+          (let* ((current-time (time))
+                 (delta (- current-time previous-time)))
+            (let update-loop ((buffer (+ buffer delta)))
+              (if (>= buffer timestep)
+                  (begin
+                    (with-error-handling error (update timestep))
+                    (update-loop (- buffer timestep)))
+                  (begin
+                    ;; We render upon every iteration of the loop, and
+                    ;; thus rendering is decoupled from updating.
+                    ;; It's possible to render multiple times before
+                    ;; an update is performed.
+                    (with-error-handling error (render (/ buffer timestep)))
+                    (loop current-time buffer)))))))
+      (lambda (cont callback)
+        #f))))
+
+
+;;;
+;;; Simple SDL + OpenGL engine
+;;;
+
+;; Good enough for simple games.
+
+(define open-controller (@@ (chickadee input controller) open-controller))
+(define close-controller (@@ (chickadee input controller) close-controller))
+(define lookup-controller (@@ (chickadee input controller) lookup-controller))
+
+(define* (run-game/sdl #:key
+                       (window-title "Chickadee!")
+                       (window-width 640)
+                       (window-height 480)
+                       window-fullscreen?
+                       (update-hz 60)
+                       (load (const #t))
+                       (update (const #t))
+                       (draw (const #t))
+                       (quit abort-game)
+                       (key-press (const #t))
+                       (key-release (const #t))
+                       (text-input (const #t))
+                       (mouse-press (const #t))
+                       (mouse-release (const #t))
+                       (mouse-move (const #t))
+                       (controller-add (const #t))
+                       (controller-remove (const #t))
+                       (controller-press (const #t))
+                       (controller-release (const #t))
+                       (controller-move (const #t))
+                       (error (const #t)))
   (sdl-init)
   ((@@ (chickadee audio) enable-audio))
   (start-text-input)
   (let ((window (open-window #:title window-title
                              #:width window-width
                              #:height window-height
-                             #:fullscreen? window-fullscreen?)))
+                             #:fullscreen? window-fullscreen?))
+        (default-viewport (make-viewport 0 0 window-width window-height))
+        (default-projection (orthographic-projection 0 window-width
+                                                     window-height 0
+                                                     0 1)))
     (define (invert-y y)
       ;; SDL's origin is the top-left, but our origin is the bottom
       ;; left so we need to invert Y coordinates that SDL gives us.
       (- window-height y))
-    (define (process-event event)
-      (cond
-       ((quit-event? event)
-        (run-hook* quit-hook))
-       ((keyboard-down-event? event)
-        (run-hook* key-press-hook
-                   (keyboard-event-key event)
-                   (keyboard-event-scancode event)
-                   (keyboard-event-modifiers event)
-                   (keyboard-event-repeat? event)))
-       ((keyboard-up-event? event)
-        (run-hook* key-release-hook
-                   (keyboard-event-key event)
-                   (keyboard-event-scancode event)
-                   (keyboard-event-modifiers event)))
-       ((text-input-event? event)
-        (run-hook* text-input-hook (text-input-event-text event)))
-       ((mouse-button-down-event? event)
-        (run-hook* mouse-press-hook
-                   (mouse-button-event-button event)
-                   (mouse-button-event-clicks event)
-                   (mouse-button-event-x event)
-                   (invert-y (mouse-button-event-y event))))
-       ((mouse-button-up-event? event)
-        (run-hook* mouse-release-hook
-                   (mouse-button-event-button event)
-                   (mouse-button-event-x event)
-                   (invert-y (mouse-button-event-y event))))
-       ((mouse-motion-event? event)
-        (run-hook* mouse-move-hook
-                   (mouse-motion-event-x event)
-                   (invert-y (mouse-motion-event-y event))
-                   (mouse-motion-event-x-rel event)
-                   (- (mouse-motion-event-y-rel event))
-                   (mouse-motion-event-buttons event)))
-       ((and (controller-device-event? event)
-             (eq? (controller-device-event-action event) 'added))
-        (run-hook* controller-add-hook
-                   (open-controller (controller-device-event-which event))))
-       ((and (controller-device-event? event)
-             (eq? (controller-device-event-action event) 'removed))
-        (let ((controller (lookup-controller
-                           (controller-device-event-which event))))
-          (run-hook* controller-remove-hook controller)
-          (close-controller controller)))
-       ((controller-button-down-event? event)
-        (run-hook* controller-press-hook
-                   (lookup-controller
-                    (controller-button-event-which event))
-                   (controller-button-event-button event)))
-       ((controller-button-up-event? event)
-        (run-hook* controller-release-hook
-                   (lookup-controller
-                    (controller-button-event-which event))
-                   (controller-button-event-button event)))
-       ((controller-axis-event? event)
-        (run-hook* controller-move-hook
-                   (lookup-controller
-                    (controller-axis-event-which event))
-                   (controller-axis-event-axis event)
-                   (/ (controller-axis-event-value event) 32768.0)))))
-    (with-window window
-      (let ((update-interval (round (/ 1000 update-hz)))
-            (default-viewport
-              (make-viewport 0 0 window-width window-height))
-            (default-projection
-              (orthographic-projection 0 window-width window-height 0 0 1)))
-        (call-with-prompt game-loop-prompt-tag
-          (lambda ()
-            ;; Catch SIGINT and kill the loop.
-            (sigaction SIGINT
-              (lambda (signum)
-                (abort-game)))
-            (run-hook* load-hook)
-            (let loop ((previous-time (sdl-ticks))
-                       (lag 0))
-              (let* ((current-time (sdl-ticks))
-                     (delta (- current-time previous-time)))
-                (let update-loop ((lag (+ lag delta)))
-                  (if (>= lag update-interval)
-                      (begin
-                        ;; Process all pending events.
-                        (let loop ((event (poll-event)))
-                          (when event
-                            (process-event event)
-                            (loop (poll-event))))
-                        ;; Advance the simulation.
-                        (run-hook* update-hook update-interval)
-                        ;; Free any GPU resources that have been GC'd.
-                        (gpu-reap!)
-                        (update-loop (- lag update-interval)))
-                      (begin
-                        ;; Render a frame.
-                        (run-hook* before-draw-hook)
-                        ;; Switch to the null viewport to ensure that
-                        ;; the default viewport will be re-applied and
-                        ;; clear the screen.
-                        (gpu-state-set! *viewport-state* null-viewport)
-                        (with-viewport default-viewport
-                          (with-projection default-projection
-                            (run-hook* draw-hook (/ lag update-interval))))
-                        (swap-buffers window)
-                        (run-hook* after-draw-hook)
-                        (loop current-time lag)))))))
-          (lambda (cont callback)
-            #f))))))
 
-(define (abort-game)
-  (abort-to-prompt game-loop-prompt-tag #f))
+    (define (input-sdl)
+      (define (process-event event)
+        (cond
+         ((quit-event? event)
+          (quit))
+         ((keyboard-down-event? event)
+          (key-press (keyboard-event-key event)
+                     (keyboard-event-scancode event)
+                     (keyboard-event-modifiers event)
+                     (keyboard-event-repeat? event)))
+         ((keyboard-up-event? event)
+          (key-release (keyboard-event-key event)
+                       (keyboard-event-scancode event)
+                       (keyboard-event-modifiers event)))
+         ((text-input-event? event)
+          (text-input (text-input-event-text event)))
+         ((mouse-button-down-event? event)
+          (mouse-press (mouse-button-event-button event)
+                       (mouse-button-event-clicks event)
+                       (mouse-button-event-x event)
+                       (invert-y (mouse-button-event-y event))))
+         ((mouse-button-up-event? event)
+          (mouse-release (mouse-button-event-button event)
+                         (mouse-button-event-x event)
+                         (invert-y (mouse-button-event-y event))))
+         ((mouse-motion-event? event)
+          (mouse-move (mouse-motion-event-x event)
+                      (invert-y (mouse-motion-event-y event))
+                      (mouse-motion-event-x-rel event)
+                      (- (mouse-motion-event-y-rel event))
+                      (mouse-motion-event-buttons event)))
+         ((and (controller-device-event? event)
+               (eq? (controller-device-event-action event) 'added))
+          (controller-add
+           (open-controller (controller-device-event-which event))))
+         ((and (controller-device-event? event)
+               (eq? (controller-device-event-action event) 'removed))
+          (let ((controller (lookup-controller
+                             (controller-device-event-which event))))
+            (controller-remove controller)
+            (close-controller controller)))
+         ((controller-button-down-event? event)
+          (controller-press (lookup-controller
+                             (controller-button-event-which event))
+                            (controller-button-event-button event)))
+         ((controller-button-up-event? event)
+          (controller-release (lookup-controller
+                               (controller-button-event-which event))
+                              (controller-button-event-button event)))
+         ((controller-axis-event? event)
+          (controller-move (lookup-controller
+                            (controller-axis-event-which event))
+                           (controller-axis-event-axis event)
+                           (/ (controller-axis-event-value event) 32768.0)))))
+      ;; Process all pending events.
+      (let loop ((event (poll-event)))
+        (when event
+          (process-event event)
+          (loop (poll-event)))))
+
+    (define (update-sdl dt)
+      (input-sdl)
+      (update dt)
+      ;; Free any GPU resources that have been GC'd.
+      (gpu-reap!))
 
-(define (time)
-  (sdl-ticks))
+    (define (render-sdl-opengl alpha)
+      ;; Switch to the null viewport to ensure that
+      ;; the default viewport will be re-applied and
+      ;; clear the screen.
+      (gpu-state-set! *viewport-state* null-viewport)
+      (with-viewport default-viewport
+        (with-projection default-projection
+          (draw alpha)))
+      (swap-buffers window))
+    (with-window window
+      (load)
+      (run-game #:update update-sdl
+                #:render render-sdl-opengl
+                #:error error
+                #:time sdl-ticks
+                #:update-hz update-hz))))