summaryrefslogtreecommitdiff
path: root/chickadee.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2018-08-20 21:50:41 -0400
committerDavid Thompson <dthompson2@worcester.edu>2018-08-23 08:01:11 -0400
commit517d129719e1f5210e1e0c8ff6e597284b41a599 (patch)
tree89a1766abe394fb4b7216dbe548b08b5b644d04c /chickadee.scm
parenteceae08c4f6985c3cc30191ab33b22302578b81e (diff)
Move SDL game loop implementation to its own module.
Diffstat (limited to 'chickadee.scm')
-rw-r--r--chickadee.scm148
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))))