diff options
Diffstat (limited to 'chickadee')
| -rw-r--r-- | chickadee/game-loop.scm | 98 | ||||
| -rw-r--r-- | chickadee/sdl.scm | 207 |
2 files changed, 98 insertions, 207 deletions
diff --git a/chickadee/game-loop.scm b/chickadee/game-loop.scm new file mode 100644 index 0000000..09f8a7b --- /dev/null +++ b/chickadee/game-loop.scm @@ -0,0 +1,98 @@ +;;; Chickadee Game Toolkit +;;; 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 +;;; by the Free Software Foundation, either version 3 of the License, +;;; or (at your option) any later version. +;;; +;;; Chickadee is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (chickadee game-loop) + #:export (run-game* + abort-game)) + + +;;; +;;; Error handling +;;; + +(define (call-with-error-handling handler thunk) + (if handler + (let ((stack #f)) + (catch #t + (lambda () + (thunk) + #f) + (lambda (key . args) + (handler stack key args) + #t) + (lambda (key . args) + (set! stack (make-stack #t 3))))) + (begin + (thunk) + #f))) + +(define-syntax-rule (with-error-handling handler body ...) + (call-with-error-handling handler (lambda () body ...))) + +(define (default-error-handler stack key args) + (apply throw key args)) + + +;;; +;;; Game loop kernel +;;; + +(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) + ;; Short-circuit the update loop if an error + ;; occurred, and reset the current time to now in + ;; order to discard the undefined amount of time + ;; that was spent handling the error. + (if (with-error-handling error (update timestep)) + (loop (time) 0) + (begin + (usleep 1) + (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. + (if (with-error-handling error (render (/ buffer timestep))) + (loop (time) 0) + (loop current-time buffer)))))))) + (lambda (cont callback) + #f)))) diff --git a/chickadee/sdl.scm b/chickadee/sdl.scm deleted file mode 100644 index 948b351..0000000 --- a/chickadee/sdl.scm +++ /dev/null @@ -1,207 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 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 -;;; by the Free Software Foundation, either version 3 of the License, -;;; or (at your option) any later version. -;;; -;;; Chickadee is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see -;;; <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Simple SDL + OpenGL game loop implementation. -;; -;;; Code: - -(define-module (chickadee sdl) - #:use-module (sdl2) - #:use-module (sdl2 events) - #:use-module (sdl2 input game-controller) - #:use-module (sdl2 input joystick) - #:use-module (sdl2 input text) - #:use-module (sdl2 mixer) - #:use-module (sdl2 video) - #:use-module (chickadee) - #:use-module (chickadee math matrix) - #:use-module (chickadee render) - #:use-module (chickadee render color) - #:use-module (chickadee render gl) - #:use-module (chickadee render gpu) - #:use-module (chickadee render viewport) - #:export (current-window - run-game/sdl)) - -(define *controllers* (make-hash-table)) - -(define (lookup-controller joystick-id) - (hashv-ref *controllers* joystick-id)) - -(define (add-controller joystick-index) - (let ((controller (open-game-controller joystick-index))) - (hashv-set! *controllers* - (joystick-instance-id - (game-controller-joystick controller)) - controller) - controller)) - -(define (remove-controller joystick-id) - (hashv-remove! *controllers* joystick-id)) - -(define (open-all-controllers) - (let loop ((i 0)) - (when (< i (num-joysticks)) - (when (game-controller-index? i) - (add-controller i)) - (loop (+ i 1))))) - -(define current-window (make-parameter #f)) - -(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) - (sdl-init) - (false-if-exception (mixer-init)) - (open-audio) - (start-text-input) - (open-all-controllers) - (let* ((window (make-window #:opengl? #t - #:title window-title - #:size (list window-width window-height) - #:fullscreen? window-fullscreen?)) - (gl-context (make-gl-context window)) - (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 (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 (add-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) - (remove-controller (controller-device-event-which event)) - (close-game-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 (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-gl-window window)) - (dynamic-wind - (const #t) - (lambda () - (parameterize ((current-window window)) - ;; Attempt to activate vsync, if possible. Some systems do - ;; not support setting the OpenGL swap interval. - (catch #t - (lambda () - (set-gl-swap-interval! 'vsync)) - (lambda args - (display "warning: could not enable vsync\n" - (current-error-port)))) - (load) - ;; Notify about all controllers that were already connected - ;; when the game was launched because SDL will not create - ;; events for them. - (hash-for-each (lambda (key controller) - (controller-add controller)) - *controllers*) - (run-game #:update update-sdl - #:render render-sdl-opengl - #:error error - #:time sdl-ticks - #:update-hz update-hz))) - (lambda () - (delete-gl-context! gl-context) - (close-window! window))))) |