summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee.scm138
1 files changed, 65 insertions, 73 deletions
diff --git a/chickadee.scm b/chickadee.scm
index e59ba12..f847915 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -44,7 +44,6 @@
controller-press-hook
controller-release-hook
controller-move-hook
- error-handler
run-game
abort-game
time))
@@ -66,10 +65,6 @@
(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))
@@ -95,67 +90,66 @@
;; left so we need to invert Y coordinates that SDL gives us.
(- window-height y))
(define (process-event event)
- (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))))))
+ (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
@@ -168,7 +162,7 @@
(sigaction SIGINT
(lambda (signum)
(abort-game)))
- (with-error-handling (run-hook load-hook))
+ (run-hook load-hook)
(let loop ((previous-time (sdl-ticks))
(lag 0))
(let* ((current-time (sdl-ticks))
@@ -182,24 +176,22 @@
(process-event event)
(loop (poll-event))))
;; Advance the simulation.
- (with-error-handling
- (run-hook update-hook update-interval))
+ (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.
- (with-error-handling (run-hook before-draw-hook))
+ (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
- (with-error-handling
- (run-hook draw-hook (/ lag update-interval)))))
+ (run-hook draw-hook (/ lag update-interval))))
(swap-buffers window)
- (with-error-handling (run-hook after-draw-hook))
+ (run-hook after-draw-hook)
(loop current-time lag)))))))
(lambda (cont callback)
#f))))))