Add joystick module.

* sly/joystick.scm: New file.
* examples/joystick.scm: New file.
* Makefile.am (SOURCES): Add sly/joystick.scm.
* TODO.org (Input): Mark as 'done'.
* sly/math.scm (linear-scale): New procedure.

5 files changed, 285 insertions, 3 deletions

diff --git a/Makefile.am b/Makefile.am
index 59c89c0..ed5cb6b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -47,6 +47,7 @@ SOURCES = 					\
   sly/transition.scm				\
   sly/vector.scm					\
   sly/window.scm					\
+  sly/joystick.scm				\
   $(WRAPPER_SOURCES)
 
 WRAPPER_SOURCES =				\
diff --git a/TODO.org b/TODO.org
index d6858eb..3f47393 100644
--- a/TODO.org
+++ b/TODO.org
@@ -5,7 +5,7 @@
    updates the game state, renders the scene. Use a fixed update
    timestep and cap the maximum FPS.
 
-** TODO Input
+** DONE Input
    Provide hooks to respond to keyboard, mouse, and joystick events.
    Wrap SDL keycode, mouse button, etc. constants in our own
    enumeration.
@@ -13,7 +13,7 @@
    - [X] Keyboard
    - [X] Mouse
    - [X] Window (active, resize, quit)
-   - [ ] Joystick
+   - [X] Joystick
 
 ** DONE Sprites
    Encapsulates an image and all of its transformations: position,
diff --git a/examples/joystick.scm b/examples/joystick.scm
new file mode 100644
index 0000000..3df938d
--- /dev/null
+++ b/examples/joystick.scm
@@ -0,0 +1,102 @@
+;;; Sly
+;;; Copyright (C) 2014 Jordan Russell <jordan.likes.curry@gmail.com>
+;;;
+;;; This program 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.
+;;;
+;;; This program 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/>.
+
+;;; Commentary:
+;;
+;; Joystick example code
+;;
+;;; Code:
+
+(use-modules
+ (sly game)
+ (sly repl)
+ (sly sprite)
+ (sly texture)
+ (sly joystick)
+ (sly signal)
+ (sly window)
+ (sly vector)
+ (sly font))
+
+(open-window)
+(start-sly-repl)
+(enable-sprites)
+(enable-joystick)
+(enable-fonts)
+
+(define default-font (load-default-font))
+
+(define resolution (vector 640 480))
+
+(add-hook! window-close-hook stop-game-loop)
+
+(define p1-texture (load-texture "images/p1_front.png"))
+
+(define-signal p1-position
+  (signal-fold v+ (vector 320 240)
+               (signal-map
+                (lambda (v)
+                  (v* (vector 8 8) v))
+                (signal-sample 1
+                               (make-directional-signal 0 0 1)))))
+
+(define* (button-caption-signal text button #:optional (joystick 0))
+  (signal-map (lambda (x)
+                (if x text ""))
+              (button-down? joystick button)))
+
+(define-signal p1-caption
+  (signal-map (lambda (text pos)
+                (make-label default-font
+                            text
+                            (v+ (vector -76 -90) pos)))
+              (signal-merge
+               (button-caption-signal "Hello there" 0)
+               (button-caption-signal "Thanks for pressing button 1" 1)
+               (button-caption-signal "This is the other caption" 2)
+               (button-caption-signal "This is the other other caption" 3))
+              p1-position))
+
+(define (draw-p1-caption dt alpha)
+  (draw-label (signal-ref p1-caption)))
+
+(define (draw-p1 dt alpha)
+  (draw-sprite (make-sprite p1-texture
+                            #:position (signal-ref p1-position))))
+
+(add-hook! draw-hook draw-p1)
+
+(add-hook! draw-hook draw-p1-caption)
+
+(add-hook! joystick-axis-hook
+           (lambda (which axis value)
+             (format #t "joystick: ~d axis: ~d raw-value: ~d value: ~f~%"
+                     which axis value (axis-scale value))))
+
+(add-hook! joystick-button-press-hook
+           (lambda (which button)
+             (format #t "button-press: (joystick: ~d button: ~d)~%"
+                     which button)))
+
+(add-hook! joystick-button-release-hook
+           (lambda (which button)
+             (format #t "button-release: (joystick: ~d button: ~d)~%"
+                     which button)))
+
+(with-window (make-window #:title "Joystick test"
+                          #:resolution resolution)
+             (start-game-loop))
diff --git a/sly/joystick.scm b/sly/joystick.scm
new file mode 100644
index 0000000..611c5ba
--- /dev/null
+++ b/sly/joystick.scm
@@ -0,0 +1,171 @@
+;;; Sly
+;;; Copyright (C) 2014 Jordan Russell <jordan.likes.curry@gmail.com>
+;;;
+;;; This program 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.
+;;;
+;;; This program 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/>.
+
+;;; Commentary:
+;;
+;; Joystick signals
+;;
+;;; Code:
+
+(define-module (sly joystick)
+  #:use-module ((sdl sdl) #:prefix SDL:)
+  #:use-module (sly event)
+  #:use-module (sly signal)
+  #:use-module (sly vector)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:re-export ((SDL:joystick-name . joystick-name)
+               (SDL:num-joysticks . num-joysticks))
+  #:export (enable-joystick
+            joystick-num-axes
+            joystick-num-buttons
+            joystick-axis-hook
+            joystick-button-press-hook
+            joystick-button-release-hook
+            axis-value-raw
+            raw-axis-max
+            raw-axis-min
+            axis-value
+            button-down?
+            make-directional-signal
+            make-directional-signal-raw
+            axis-scale))
+
+(define *joysticks* '())
+
+(define (enable-joystick)
+  (set! *joysticks*
+        (map SDL:joystick-open
+             (iota (SDL:num-joysticks)))))
+
+(define (get-joystick idx)
+  (list-ref *joysticks* idx))
+
+(define-syntax-rule (js-proc->idx-proc (js-proc . name) doc)
+  (define (name idx)
+    doc
+    (if (> idx (SDL:num-joysticks))
+        0
+        (js-proc (get-joystick idx)))))
+
+(js-proc->idx-proc (SDL:joystick-num-axes . joystick-num-axes)
+                   "Get number of axes of joystick at IDX")
+
+(js-proc->idx-proc (SDL:joystick-num-buttons . joystick-num-buttons)
+                   "Get number of buttons of joystick at IDX")
+
+(define joystick-axis-hook (make-hook 3))
+
+(register-event-handler
+ 'joy-axis-motion
+ (lambda (e)
+   (run-hook joystick-axis-hook
+             (SDL:event:jaxis:which e)
+             (SDL:event:jaxis:axis e)
+             (SDL:event:jaxis:value e))))
+
+(define-record-type <axis-event>
+  (make-axis-event which axis value)
+  axis-event?
+  (which axis-event-joystick)
+  (axis axis-event-axis)
+  (value axis-event-value))
+
+(define joystick-button-press-hook (make-hook 2))
+
+(register-event-handler
+ 'joy-button-down
+ (lambda (e)
+   (run-hook joystick-button-press-hook
+             (SDL:event:jbutton:which e)
+             (SDL:event:jbutton:button e))))
+
+(define joystick-button-release-hook (make-hook 2))
+
+(register-event-handler
+ 'joy-button-up
+ (lambda (e)
+   (run-hook joystick-button-release-hook
+             (SDL:event:jbutton:which e)
+             (SDL:event:jbutton:button e))))
+
+(define-signal last-axis-event
+  (hook->signal joystick-axis-hook 'none
+                make-axis-event))
+
+(define raw-axis-min -32768)
+(define raw-axis-max 32767)
+
+(define (axis-value-raw idx axis)
+  "Create a signal on the axis at AXIS of the joystick at IDX;
+joystick axis values are stored in a signed 16 bit integer and so,
+values range from [-32768,32767]"
+  (signal-map axis-event-value
+              (signal-filter
+               (lambda (e)
+                 (and (axis-event? e)
+                      (= (axis-event-joystick e) idx)
+                      (= (axis-event-axis e) axis)))
+               (make-axis-event idx axis 0)
+               last-axis-event)))
+
+(define (make-directional-signal-raw idx x-axis y-axis)
+  "Create a signal for a Dpad or Analog stick with X and Y axes;
+values range from [-32768,32767]"
+  (signal-map vector
+              (axis-value-raw idx x-axis)
+              (axis-value-raw idx y-axis)))
+
+(define (axis-scale raw-value)
+  "Map a RAW-VALUE in [-32768, 32767] to a value in [-1, 1]"
+  (define (clamp x)
+    (cond ((< (abs x) 1/100) 0)
+          ((> x 99/100) 1)
+          ((< x -99/100) -1)
+          (else x)))
+  (clamp (/ raw-value 32768)))
+
+(define (axis-value idx axis)
+  "Create a signal for the value of AXIS on joystick IDX;
+values are scaled to [-1,1]"
+  (signal-map axis-scale (axis-value-raw idx axis)))
+
+(define (make-directional-signal idx x-axis y-axis)
+  "Create a signal for a Dpad or Analog stick with X and Y axes;
+values are scaled to [-1,1]"
+  (signal-map (lambda (v)
+                (vector (axis-scale (vx v))
+                        (axis-scale (vy v))))
+              (make-directional-signal-raw idx x-axis y-axis)))
+
+(define-signal button-last-down
+  (hook->signal joystick-button-press-hook 'none
+                list))
+
+(define-signal button-last-up
+  (hook->signal joystick-button-release-hook 'none
+                list))
+
+;; shamelessly copied from keyboard.scm
+(define (button-down? idx n)
+  "Create a signal for the state of button N on joystick at IDX"
+  (define (same-button? l)
+    (equal? (list idx n) l))
+  (define (button-filter value signal)
+    (signal-constant value (signal-filter same-button? #f signal)))
+  (signal-merge (button-filter #f button-last-up)
+                (button-filter #t button-last-down)))
diff --git a/sly/math.scm b/sly/math.scm
index 073a399..c25e24d 100644
--- a/sly/math.scm
+++ b/sly/math.scm
@@ -1,5 +1,6 @@
 ;;; Sly
 ;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
+;;; Copyright (C) 2014 Jordan Russell <jordan.likes.curry@gmail.com>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -29,7 +30,8 @@
             cos-degrees
             tan-degrees
             atan-degrees
-            clamp))
+            clamp
+            linear-scale))
 
 ;; Dave was editing this module on Pi Approximation Day.
 ;;
@@ -89,3 +91,9 @@ actually less than MAX."
   (cond ((< x min) min)
         ((> x max) max)
         (else x)))
+
+(define (linear-scale min max a b val)
+  "Map a VAL in the range [MIN,MAX] to numbers in [A,B]"
+  (+ a
+     (/ (* (- b a) (- val min))
+        (- max min))))