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 { 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 :: [SDL.EventPayload] -> Controls -> Controls updateGamepad events controls | 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 controls.a $ isPressedGamepad SDL.ControllerButtonA events, b = fromMaybe controls.b $ isPressedGamepad SDL.ControllerButtonB events, menu = fromMaybe controls.menu $ isPressedGamepad SDL.ControllerButtonStart events } updateKeyboard :: [SDL.EventPayload] -> Controls -> Controls updateKeyboard events controls = 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 controls.a $ isPressed SDL.KeycodeZ events, b = fromMaybe controls.b $ isPressed SDL.KeycodeX events, menu = fromMaybe controls.menu $ isPressed SDL.KeycodeReturn events } update :: [SDL.EventPayload] -> Controls -> Controls update events controls = do updateGamepad events $ updateKeyboard events controls