66441a971ff6bd92b79f9b2a869704be32f3cbd6
[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 (open-game-controller
34 close-game-controller
35 game-controller?
36 game-controller-attached?
37 game-controller-joystick
38 game-controller-name
39 game-controller-axis
40 game-controller-button-pressed?
41 game-controller-index?))
42
43 (define-wrapped-pointer-type <game-controller>
44 game-controller?
45 wrap-game-controller unwrap-game-controller
46 (lambda (game-controller port)
47 (format port "#<game-controller ~a>"
48 (game-controller-name game-controller))))
49
50 (define-record-type <game-controller>
51 (make-game-controller pointer joystick)
52 game-controller?
53 (pointer unwrap-game-controller)
54 (joystick %game-controller-joystick))
55
56 (set-record-type-printer! <game-controller>
57 (lambda (game-controller port)
58 (format port "#<game-controller ~s>"
59 (game-controller-name game-controller))))
60
61 (define wrap-joystick (@@ (sdl2 input joystick) wrap-joystick))
62
63 (define (open-game-controller joystick-index)
64 "Return a game controller object for the physical joystick device
65 associated with ."
66 (let ((ptr (ffi:sdl-game-controller-open joystick-index)))
67 (if (null-pointer? ptr)
68 (sdl-error "open-game-controller" "failed to open game controller")
69 (let ((joystick (wrap-joystick
70 (ffi:sdl-game-controller-get-joystick ptr))))
71 (make-game-controller ptr joystick)))))
72
73 (define (close-game-controller controller)
74 "Close CONTROLLER."
75 (ffi:sdl-game-controller-close (unwrap-game-controller controller)))
76
77 (define (game-controller-joystick controller)
78 "Return the underlying joystick object associated with CONTROLLER."
79 (%game-controller-joystick controller))
80
81 (define (game-controller-attached? controller)
82 "Return #t if CONTROLLER is currently in use."
83 (= (ffi:sdl-game-controller-get-attached (unwrap-game-controller controller)) 1))
84
85 (define (game-controller-name controller)
86 "Return the human readable name for CONTROLLER."
87 (pointer->string (ffi:sdl-game-controller-name (unwrap-game-controller controller))))
88
89 (define (axis-symbol->int axis)
90 (match axis
91 ('left-x ffi:SDL_CONTROLLER_AXIS_LEFTX)
92 ('left-y ffi:SDL_CONTROLLER_AXIS_LEFTY)
93 ('right-x ffi:SDL_CONTROLLER_AXIS_RIGHTX)
94 ('right-x ffi:SDL_CONTROLLER_AXIS_RIGHTY)
95 ('trigger-left ffi:SDL_CONTROLLER_AXIS_TRIGGERLEFT)
96 ('trigger-right ffi:SDL_CONTROLLER_AXIS_TRIGGERRIGHT)))
97
98 (define (game-controller-axis controller axis)
99 "Return a number in the range [-32768, 32767] representing the
100 current state of AXIS on CONTROLLER.
101
102 AXIS may be one of the following symbols:
103 - left-x
104 - left-y
105 - right-x
106 - right-y
107 - trigger-left
108 - trigger-right"
109 (ffi:sdl-game-controller-get-axis (unwrap-game-controller controller)
110 (axis-symbol->int axis)))
111
112 (define (button-symbol->int button)
113 (match button
114 ('a ffi:SDL_CONTROLLER_BUTTON_A)
115 ('b ffi:SDL_CONTROLLER_BUTTON_B)
116 ('x ffi:SDL_CONTROLLER_BUTTON_X)
117 ('y ffi:SDL_CONTROLLER_BUTTON_Y)
118 ('back ffi:SDL_CONTROLLER_BUTTON_BACK)
119 ('guide ffi:SDL_CONTROLLER_BUTTON_GUIDE)
120 ('start ffi:SDL_CONTROLLER_BUTTON_START)
121 ('left-stick ffi:SDL_CONTROLLER_BUTTON_LEFTSTICK)
122 ('right-stick ffi:SDL_CONTROLLER_BUTTON_RIGHTSTICK)
123 ('left-shoulder ffi:SDL_CONTROLLER_BUTTON_LEFTSHOULDER)
124 ('right-shoulder ffi:SDL_CONTROLLER_BUTTON_RIGHTSHOULDER)
125 ('dpad-up ffi:SDL_CONTROLLER_BUTTON_DPAD_UP)
126 ('dpad-down ffi:SDL_CONTROLLER_BUTTON_DPAD_DOWN)
127 ('dpad-left ffi:SDL_CONTROLLER_BUTTON_DPAD_LEFT)
128 ('dpad-right ffi:SDL_CONTROLLER_BUTTON_DPAD_RIGHT)))
129
130 (define (game-controller-button-pressed? controller button)
131 "Return #t if BUTTON is pressed on CONTROLLER.
132
133 BUTTON may be one of the following symbols:
134 - a
135 - b
136 - x
137 - y
138 - back
139 - guide
140 - start
141 - left-stick
142 - right-stick
143 - left-shoulder
144 - right-shoulder
145 - dpad-up
146 - dpad-down
147 - dpad-left
148 - dpad-right"
149 (= (ffi:sdl-game-controller-get-button (unwrap-game-controller controller)
150 (button-symbol->int button))
151 1))
152
153 (define (game-controller-index? joystick-index)
154 "Return #t if JOYSTICK-INDEX is a valid game controller index."
155 (= (ffi:sdl-is-game-controller joystick-index) 1))