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
|
module Game.Controller (Controls (..), init, update) where
import Data.Maybe (fromMaybe, 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
{ cUp :: Bool,
cDown :: Bool,
cLeft :: Bool,
cRight :: Bool,
cA :: Bool,
cB :: Bool,
cMenu :: Bool,
cJoy :: 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 :: [SDL.EventPayload] -> Controls -> Controls
updateGamepad events controls
| isNothing $ cJoy controls = controls
-- XXX: deal with disconnection/reconnection
| otherwise =
controls
{ cUp = fromMaybe (cUp controls) $ isPressedGamepad SDL.ControllerButtonDpadUp events,
cDown = fromMaybe (cDown controls) $ isPressedGamepad SDL.ControllerButtonDpadDown events,
cLeft = fromMaybe (cLeft controls) $ isPressedGamepad SDL.ControllerButtonDpadLeft events,
cRight = fromMaybe (cRight controls) $ isPressedGamepad SDL.ControllerButtonDpadRight events,
cA = fromMaybe (cA controls) $ isPressedGamepad SDL.ControllerButtonA events,
cB = fromMaybe (cB controls) $ isPressedGamepad SDL.ControllerButtonB events,
cMenu = fromMaybe (cMenu controls) $ isPressedGamepad SDL.ControllerButtonStart events
}
updateKeyboard :: [SDL.EventPayload] -> Controls -> Controls
updateKeyboard events controls =
controls
{ cUp = fromMaybe (cUp controls) $ isPressed SDL.KeycodeUp events,
cDown = fromMaybe (cDown controls) $ isPressed SDL.KeycodeDown events,
cLeft = fromMaybe (cLeft controls) $ isPressed SDL.KeycodeLeft events,
cRight = fromMaybe (cRight controls) $ isPressed SDL.KeycodeRight events,
cA = fromMaybe (cA controls) $ isPressed SDL.KeycodeZ events,
cB = fromMaybe (cB controls) $ isPressed SDL.KeycodeX events,
cMenu = fromMaybe (cMenu controls) $ isPressed SDL.KeycodeReturn events
}
update :: [SDL.EventPayload] -> Controls -> Controls
update events controls = do
updateGamepad events $ updateKeyboard events controls
|
