Move SDL game loop implementation to its own module.

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))))