diff options
Diffstat (limited to 'chickadee.scm')
| -rw-r--r-- | chickadee.scm | 148 |
1 files changed, 2 insertions, 146 deletions
diff --git a/chickadee.scm b/chickadee.scm index eb98443..09212fe 100644 --- a/chickadee.scm +++ b/chickadee.scm @@ -16,20 +16,8 @@ ;;; <http://www.gnu.org/licenses/>. (define-module (chickadee) - #:use-module (gl) - #:use-module (sdl2) - #:use-module (sdl2 events) - #:use-module (sdl2 input text) - #:use-module (chickadee math matrix) - #:use-module (chickadee window) - #: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 (run-game* - abort-game - run-game/sdl)) + #:export (run-game + abort-game)) ;;; @@ -99,135 +87,3 @@ (loop current-time buffer))))))) (lambda (cont callback) #f)))) - - -;;; -;;; Simple SDL + OpenGL engine -;;; - -;; Good enough for simple games. - -(define open-controller (@@ (chickadee input controller) open-controller)) -(define close-controller (@@ (chickadee input controller) close-controller)) -(define lookup-controller (@@ (chickadee input controller) lookup-controller)) - -(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 (const #t))) - (sdl-init) - ((@@ (chickadee audio) enable-audio)) - (start-text-input) - (let ((window (open-window #:title window-title - #:width window-width - #:height window-height - #:fullscreen? window-fullscreen?)) - (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 - (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)))) - (controller-remove controller) - (close-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-buffers window)) - (with-window window - (load) - (run-game #:update update-sdl - #:render render-sdl-opengl - #:error error - #:time sdl-ticks - #:update-hz update-hz)))) |