Add error handling to game loop.

* chickadee.scm (error-handler): New procedure.
(with-error-handling): New syntax.
(run-game): Handle errors caught when running hooks.

1 files changed, 73 insertions, 65 deletions

diff --git a/chickadee.scm b/chickadee.scm
index f847915..e59ba12 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -44,6 +44,7 @@
             controller-press-hook
             controller-release-hook
             controller-move-hook
+            error-handler
             run-game
             abort-game
             time))
@@ -65,6 +66,10 @@
 (define controller-press-hook (make-hook 2))
 (define controller-release-hook (make-hook 2))
 (define controller-move-hook (make-hook 3))
+(define error-handler (lambda args (apply throw args)))
+
+(define-syntax-rule (with-error-handling body ...)
+  (catch #t (lambda () body ...) error-handler))
 
 (define open-controller (@@ (chickadee input controller) open-controller))
 (define close-controller (@@ (chickadee input controller) close-controller))
@@ -90,66 +95,67 @@
       ;; 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)
-                  (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-error-handling
+        (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)
+                    (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
@@ -162,7 +168,7 @@
             (sigaction SIGINT
               (lambda (signum)
                 (abort-game)))
-            (run-hook load-hook)
+            (with-error-handling (run-hook load-hook))
             (let loop ((previous-time (sdl-ticks))
                        (lag 0))
               (let* ((current-time (sdl-ticks))
@@ -176,22 +182,24 @@
                             (process-event event)
                             (loop (poll-event))))
                         ;; Advance the simulation.
-                        (run-hook update-hook update-interval)
+                        (with-error-handling
+                          (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)
+                        (with-error-handling (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))))
+                            (with-error-handling
+                              (run-hook draw-hook (/ lag update-interval)))))
                         (swap-buffers window)
-                        (run-hook after-draw-hook)
+                        (with-error-handling (run-hook after-draw-hook))
                         (loop current-time lag)))))))
           (lambda (cont callback)
             #f))))))