blob: cb441205c9fed5d527a64123bb1c88f7d8c8e9fe (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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-inlinable (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))
|
