1 files changed, 87 insertions, 0 deletions
diff --git a/chickadee/input/controller.scm b/chickadee/input/controller.scm
new file mode 100644
index 0000000..e78623e
--- /dev/null
+++ b/chickadee/input/controller.scm
@@ -0,0 +1,87 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 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
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee input controller)
+  #:use-module (srfi srfi-9)
+  #:use-module (sdl2)
+  #:use-module ((sdl2 input game-controller) #:prefix sdl2:)
+  #:use-module ((sdl2 input joystick) #:prefix sdl2:)
+  #:export (controller?
+            controller-name
+            controller-power-level
+            controller-button-pressed?
+            controller-axis))
+
+(define-record-type <controller>
+  (wrap-controller sdl-controller)
+  controller?
+  (sdl-controller unwrap-controller))
+
+(define %controllers (make-hash-table))
+
+(define (open-controller index)
+  (let* ((sdl-controller (sdl2:open-game-controller index))
+         (controller (wrap-controller sdl-controller)))
+    ;; Register controller in global hash table for future lookup.
+    (hash-set! %controllers
+               (sdl2:joystick-instance-id
+                (sdl2:game-controller-joystick sdl-controller))
+               controller)
+    controller))
+
+(define (close-controller controller)
+  (hash-remove! %controllers
+                (sdl2:joystick-instance-id
+                 (sdl2:game-controller-joystick
+                  (unwrap-controller controller))))
+  (sdl2:close-game-controller (unwrap-controller controller)))
+
+(define (lookup-controller instance-id)
+  (hash-ref %controllers instance-id))
+
+(define (controller-name controller)
+  "Return the human readable model name of CONTROLLER."
+  (sdl2:game-controller-name (unwrap-controller controller)))
+
+(define (controller-power-level controller)
+  "Return the symbolic power level for CONTROLLER.
+
+Possible return values are:
+- unknown
+- empty
+- low
+- medium
+- full
+- wired"
+  (sdl2:joystick-power-level
+   (sdl2:game-controller-joystick
+    (unwrap-controller controller))))
+
+(define (controller-connected? controller)
+  "Return #t if CONTROLLER is currently in use."
+  (sdl2:game-controller-attached? (unwrap-controller controller)))
+
+(define (controller-button-pressed? controller button)
+  "Return #t if BUTTON is currently being pressed on CONTROLLER."
+  (sdl2:game-controller-button-pressed? (unwrap-controller controller) button))
+
+(define (controller-axis controller axis)
+  "Return a floating point value in the range [-1, 1] corresponding to
+how much AXIS is being pushed on CONTROLLER.  0 is returned if AXIS is
+not being pushed at all."
+  (/ (sdl2:game-controller-axis (unwrap-controller controller) axis)
+     32768.0))