diff options
Diffstat (limited to 'chickadee.scm')
| -rw-r--r-- | chickadee.scm | 256 |
1 files changed, 183 insertions, 73 deletions
diff --git a/chickadee.scm b/chickadee.scm index 386e99f..3c10880 100644 --- a/chickadee.scm +++ b/chickadee.scm @@ -1,5 +1,5 @@ ;;; Chickadee Game Toolkit -;;; Copyright © 2016, 2018 David Thompson <davet@gnu.org> +;;; 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 @@ -15,84 +15,194 @@ ;;; along with this program. If not, see ;;; <http://www.gnu.org/licenses/>. +;;; Commentary: +;; +;; Simple SDL + OpenGL game loop implementation. +;; +;;; Code: + (define-module (chickadee) - #:export (run-game - abort-game)) + #: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 game-loop) + #: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) + #:re-export (abort-game)) - -;;; -;;; Error handling -;;; +(define *controllers* (make-hash-table)) -(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 (lookup-controller joystick-id) + (hashv-ref *controllers* joystick-id)) -(define-syntax-rule (with-error-handling handler body ...) - (call-with-error-handling handler (lambda () body ...))) +(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 (default-error-handler stack key args) - (apply throw key args)) +(define (remove-controller joystick-id) + (hashv-remove! *controllers* joystick-id)) - -;;; -;;; Game loop kernel -;;; - -(define game-loop-prompt-tag (make-prompt-tag 'game-loop)) +(define (open-all-controllers) + (let loop ((i 0)) + (when (< i (num-joysticks)) + (when (game-controller-index? i) + (add-controller i)) + (loop (+ i 1))))) -(define (abort-game) - (abort-to-prompt game-loop-prompt-tag #f)) +(define current-window (make-parameter #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 +(define* (run-game #: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 () - ;; 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)))) + (delete-gl-context! gl-context) + (close-window! window))))) |