summaryrefslogtreecommitdiff
path: root/chickadee.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2018-01-12 20:42:37 -0500
committerDavid Thompson <dthompson2@worcester.edu>2018-01-12 20:42:37 -0500
commit8cbb7eed56c4b5edd780c2d51aaa0a4c3eab7350 (patch)
treed3ca25a1afa7b3ff0715dd208924619e30f5e678 /chickadee.scm
parent73abe46d531292271d96809cc862b86906e692d3 (diff)
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.
Diffstat (limited to 'chickadee.scm')
-rw-r--r--chickadee.scm138
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))))))