Re-hide SDL2 details.

I know I'm backpedaling here, but I think it was a mistake to expose
SDL2 as much as I have here.  I think it's better for people just
getting started to not have to wonder what SDL means.  Making things
as usable as possible for beginners is an important goal, and
abstracting SDL2 + OpenGL things from the core game loop
implementation shouldn't require sacrificing that goal.

* chickadee.scm: Switch code with...
* chickadee/game-loop.scm: ...this! Which is copied straight from...
* chickadee/sdl.scm: ...this! Which is now deleted.
* Makefile.am (SOURCES): Add game-loop.scm, remove sdl.scm.
* examples/grid.scm: Update due to API breakage.
* examples/lines.scm: Ditto.
* examples/nine-patch.scm: Ditto.
* examples/sprite.scm: Ditto.
* examples/text.scm: Ditto.
* examples/tiled.scm: Ditto.
* doc/api.texi (Kernel): Update.

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