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
|
module Game.Controller (Controls (..), init, update) where
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Vector ((!?))
import Game.Utils (isPressed, isPressedGamepad)
import qualified SDL
import qualified SDL.Input.GameController as SDL
import qualified SDL.Raw
import Prelude hiding (init)
data Controls = Controls
{ up :: Bool,
down :: Bool,
left :: Bool,
right :: Bool,
a :: Bool,
b :: Bool,
menu :: Bool,
joy :: Maybe SDL.Raw.Joystick
}
deriving (Show)
getJoystick :: IO (Maybe SDL.Raw.Joystick)
getJoystick = do
joys <- SDL.availableJoysticks
case joys !? 0 of
Nothing -> pure Nothing
Just x ->
Just <$> do
-- XXX: are we sure this is a gamepad?
putStrLn ("gamepad: " ++ show x)
let joyId = SDL.joystickDeviceId x
g <- SDL.Raw.gameControllerOpen joyId
SDL.Raw.gameControllerGetJoystick g
init :: IO Controls
init = do
Controls False False False False False False False <$> getJoystick
updateGamepad :: Controls -> [SDL.EventPayload] -> Controls
updateGamepad controls events
| isNothing $ controls.joy = controls
-- XXX: deal with disconnection/reconnection
| otherwise =
controls
{ up = fromMaybe controls.up $ isPressedGamepad SDL.ControllerButtonDpadUp events,
down = fromMaybe controls.down $ isPressedGamepad SDL.ControllerButtonDpadDown events,
left = fromMaybe controls.left $ isPressedGamepad SDL.ControllerButtonDpadLeft events,
right = fromMaybe controls.right $ isPressedGamepad SDL.ControllerButtonDpadRight events,
a = fromMaybe False $ isPressedGamepad SDL.ControllerButtonA events,
b = fromMaybe False $ isPressedGamepad SDL.ControllerButtonB events,
menu = fromMaybe False $ isPressedGamepad SDL.ControllerButtonStart events
}
updateKeyboard :: Controls -> [SDL.EventPayload] -> Controls
updateKeyboard controls events =
controls
{ up = fromMaybe controls.up $ isPressed SDL.KeycodeUp events,
down = fromMaybe controls.down $ isPressed SDL.KeycodeDown events,
left = fromMaybe controls.left $ isPressed SDL.KeycodeLeft events,
right = fromMaybe controls.right $ isPressed SDL.KeycodeRight events,
a = fromMaybe False $ isPressed SDL.KeycodeZ events,
b = fromMaybe False $ isPressed SDL.KeycodeX events,
menu = fromMaybe False $ isPressed SDL.KeycodeReturn events
}
update :: Controls -> [SDL.EventPayload] -> Controls
update controls
| isJust controls.joy = updateGamepad controls
| otherwise = updateKeyboard controls
|
