Add SDL_GameControllerAddMappingsFromRW binding.
[guile-sdl2.git] / sdl2 / input / game-controller.scm
1 ;;; guile-sdl2 --- FFI bindings for SDL2
2 ;;; Copyright © 2016 David Thompson <davet@gnu.org>
3 ;;;
4 ;;; This file is part of guile-sdl2.
5 ;;;
6 ;;; Guile-sdl2 is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU Lesser General Public License as
8 ;;; published by the Free Software Foundation; either version 3 of the
9 ;;; License, or (at your option) any later version.
10 ;;;
11 ;;; Guile-sdl2 is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;; General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU Lesser General Public
17 ;;; License along with guile-sdl2. If not, see
18 ;;; <http://www.gnu.org/licenses/>.
19
20 ;;; Commentary:
21 ;;
22 ;; Joystick input.
23 ;;
24 ;;; Code:
25
26 (define-module (sdl2 input game-controller)
27 #:use-module (ice-9 match)
28 #:use-module (srfi srfi-9)
29 #:use-module (srfi srfi-9 gnu)
30 #:use-module (system foreign)
31 #:use-module ((sdl2 bindings) #:prefix ffi:)
32 #:use-module (sdl2)
33 #:export (load-game-controller-mappings!
34 open-game-controller
35 close-game-controller
36 game-controller?
37 game-controller-attached?
38 game-controller-joystick
39 game-controller-name
40 game-controller-axis
41 game-controller-button-pressed?
42 game-controller-index?))
43
44 (define-wrapped-pointer-type <game-controller>
45 game-controller?
46 wrap-game-controller unwrap-game-controller
47 (lambda (game-controller port)
48 (format port "#<game-controller ~a>"
49 (game-controller-name game-controller))))
50
51 (define-record-type <game-controller>
52 (make-game-controller pointer joystick)
53 game-controller?
54 (pointer unwrap-game-controller)
55 (joystick %game-controller-joystick))
56
57 (set-record-type-printer! <game-controller>
58 (lambda (game-controller port)
59 (format port "#<game-controller ~s>"
60 (game-controller-name game-controller))))
61
62 (define wrap-joystick (@@ (sdl2 input joystick) wrap-joystick))
63
64 (define (load-game-controller-mappings! file)
65 "Load game controller mappings from FILE and return the number of
66 mappings added this way.
67
68 See
69 https://raw.github.com/gabomdq/SDL_GameControllerDB/master/gamecontrollerdb.txt
70 for a community maintained controller mapping file."
71 (let ((count (ffi:sdl-game-controller-add-mappings-from-rw
72 (ffi:sdl-rw-from-file (string->pointer file)
73 (string->pointer "rb"))
74 1)))
75 (if (= count -1)
76 (sdl-error "load-game-controller-mappings!"
77 (string-append "failed to load game controller mappings from file "
78 file))
79 count)))
80
81 (define (open-game-controller joystick-index)
82 "Return a game controller object for the physical joystick device
83 associated with ."
84 (let ((ptr (ffi:sdl-game-controller-open joystick-index)))
85 (if (null-pointer? ptr)
86 (sdl-error "open-game-controller" "failed to open game controller")
87 (let ((joystick (wrap-joystick
88 (ffi:sdl-game-controller-get-joystick ptr))))
89 (make-game-controller ptr joystick)))))
90
91 (define (close-game-controller controller)
92 "Close CONTROLLER."
93 (ffi:sdl-game-controller-close (unwrap-game-controller controller)))
94
95 (define (game-controller-joystick controller)
96 "Return the underlying joystick object associated with CONTROLLER."
97 (%game-controller-joystick controller))
98
99 (define (game-controller-attached? controller)
100 "Return #t if CONTROLLER is currently in use."
101 (= (ffi:sdl-game-controller-get-attached (unwrap-game-controller controller)) 1))
102
103 (define (game-controller-name controller)
104 "Return the human readable name for CONTROLLER."
105 (pointer->string (ffi:sdl-game-controller-name (unwrap-game-controller controller))))
106
107 (define (axis-symbol->int axis)
108 (match axis
109 ('left-x ffi:SDL_CONTROLLER_AXIS_LEFTX)
110 ('left-y ffi:SDL_CONTROLLER_AXIS_LEFTY)
111 ('right-x ffi:SDL_CONTROLLER_AXIS_RIGHTX)
112 ('right-x ffi:SDL_CONTROLLER_AXIS_RIGHTY)
113 ('trigger-left ffi:SDL_CONTROLLER_AXIS_TRIGGERLEFT)
114 ('trigger-right ffi:SDL_CONTROLLER_AXIS_TRIGGERRIGHT)))
115
116 (define (game-controller-axis controller axis)
117 "Return a number in the range [-32768, 32767] representing the
118 current state of AXIS on CONTROLLER.
119
120 AXIS may be one of the following symbols:
121 - left-x
122 - left-y
123 - right-x
124 - right-y
125 - trigger-left
126 - trigger-right"
127 (ffi:sdl-game-controller-get-axis (unwrap-game-controller controller)
128 (axis-symbol->int axis)))
129
130 (define (button-symbol->int button)
131 (match button
132 ('a ffi:SDL_CONTROLLER_BUTTON_A)
133 ('b ffi:SDL_CONTROLLER_BUTTON_B)
134 ('x ffi:SDL_CONTROLLER_BUTTON_X)
135 ('y ffi:SDL_CONTROLLER_BUTTON_Y)
136 ('back ffi:SDL_CONTROLLER_BUTTON_BACK)
137 ('guide ffi:SDL_CONTROLLER_BUTTON_GUIDE)
138 ('start ffi:SDL_CONTROLLER_BUTTON_START)
139 ('left-stick ffi:SDL_CONTROLLER_BUTTON_LEFTSTICK)
140 ('right-stick ffi:SDL_CONTROLLER_BUTTON_RIGHTSTICK)
141 ('left-shoulder ffi:SDL_CONTROLLER_BUTTON_LEFTSHOULDER)
142 ('right-shoulder ffi:SDL_CONTROLLER_BUTTON_RIGHTSHOULDER)
143 ('dpad-up ffi:SDL_CONTROLLER_BUTTON_DPAD_UP)
144 ('dpad-down ffi:SDL_CONTROLLER_BUTTON_DPAD_DOWN)
145 ('dpad-left ffi:SDL_CONTROLLER_BUTTON_DPAD_LEFT)
146 ('dpad-right ffi:SDL_CONTROLLER_BUTTON_DPAD_RIGHT)))
147
148 (define (game-controller-button-pressed? controller button)
149 "Return #t if BUTTON is pressed on CONTROLLER.
150
151 BUTTON may be one of the following symbols:
152 - a
153 - b
154 - x
155 - y
156 - back
157 - guide
158 - start
159 - left-stick
160 - right-stick
161 - left-shoulder
162 - right-shoulder
163 - dpad-up
164 - dpad-down
165 - dpad-left
166 - dpad-right"
167 (= (ffi:sdl-game-controller-get-button (unwrap-game-controller controller)
168 (button-symbol->int button))
169 1))
170
171 (define (game-controller-index? joystick-index)
172 "Return #t if JOYSTICK-INDEX is a valid game controller index."
173 (= (ffi:sdl-is-game-controller joystick-index) 1))