From 1a8ffb0ea7233c55148118c09a7b281673df86c2 Mon Sep 17 00:00:00 2001 From: Jordan Russell Date: Thu, 10 Jul 2014 21:29:02 -0700 Subject: 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. --- sly/joystick.scm | 171 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ sly/math.scm | 10 +++- 2 files changed, 180 insertions(+), 1 deletion(-) create mode 100644 sly/joystick.scm (limited to 'sly') 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 +;;; +;;; 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 +;;; . + +;;; 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 + (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 +;;; Copyright (C) 2014 Jordan Russell ;;; ;;; 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)))) -- cgit v1.2.3