module Game.Controller (Controls (..), init, update, isPressed, isModKey, altMod) where import Control.Monad import Data.Int (Int32) import Data.Maybe (fromMaybe, isNothing) import Foreign.C (peekCAString) 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, joyId :: Maybe Int32, gc :: Maybe SDL.Raw.GameController } deriving (Show) processControllerEvents :: Controls -> [SDL.EventPayload] -> IO Controls processControllerEvents controls (SDL.ControllerDeviceEvent (SDL.ControllerDeviceEventData SDL.ControllerDeviceAdded joyIndex) : t) = do if isNothing controls.joyId then do joyName <- peekCAString =<< SDL.Raw.gameControllerNameForIndex (fromIntegral joyIndex) putStrLn $ "Connected gamepad: " ++ show joyName gc <- SDL.Raw.gameControllerOpen (fromIntegral joyIndex) joy <- SDL.Raw.gameControllerGetJoystick gc joyId <- SDL.Raw.joystickInstanceID joy processControllerEvents controls {joyId = Just joyId, gc = Just gc} t else processControllerEvents controls t processControllerEvents controls (SDL.ControllerDeviceEvent (SDL.ControllerDeviceEventData SDL.ControllerDeviceRemoved joyId) : t) = do c <- if Just joyId == controls.joyId then do forM_ (controls.gc) SDL.Raw.gameControllerClose putStrLn "Disconnected gamepad" pure controls {joyId = Nothing, gc = Nothing} else pure controls processControllerEvents c t processControllerEvents controls (_ : t) = processControllerEvents controls t processControllerEvents controls [] = pure controls init :: Controls init = Controls False False False False False False False Nothing Nothing altMod :: SDL.KeyModifier altMod = SDL.KeyModifier False False False False True False False False False False False updateGamepad :: Controls -> [SDL.EventPayload] -> Controls updateGamepad controls events = case controls.joyId of Nothing -> controls Just joyId -> controls { up = fromMaybe controls.up $ isPressedGamepad joyId SDL.ControllerButtonDpadUp events, down = fromMaybe controls.down $ isPressedGamepad joyId SDL.ControllerButtonDpadDown events, left = fromMaybe controls.left $ isPressedGamepad joyId SDL.ControllerButtonDpadLeft events, right = fromMaybe controls.right $ isPressedGamepad joyId SDL.ControllerButtonDpadRight events, a = fromMaybe False $ isPressedGamepad joyId SDL.ControllerButtonA events, b = fromMaybe False $ isPressedGamepad joyId SDL.ControllerButtonB events, menu = fromMaybe False $ isPressedGamepad joyId 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] -> IO Controls update controls events = do updated <- processControllerEvents controls events pure $ case updated.joyId of Just _ -> updateGamepad updated events _ -> updateKeyboard updated events isPressed :: SDL.Keycode -> [SDL.EventPayload] -> Maybe Bool isPressed code events | any (isEventKey SDL.Pressed code) events = Just True | any (isEventKey SDL.Released code) events = Just False | otherwise = Nothing where isEventKey :: SDL.InputMotion -> SDL.Keycode -> SDL.EventPayload -> Bool isEventKey expected keycode (SDL.KeyboardEvent (SDL.KeyboardEventData _ motion False ksym)) = expected == motion && SDL.keysymKeycode ksym == keycode isEventKey _ _ _ = False isModKey :: SDL.KeyModifier -> [SDL.EventPayload] -> Bool isModKey kmod = any (isModKeyOne kmod) where isModKeyOne m (SDL.KeyboardEvent (SDL.KeyboardEventData _ _ _ ksym)) = SDL.keysymModifier ksym == m isModKeyOne _ _ = False isPressedGamepad :: Int32 -> SDL.ControllerButton -> [SDL.EventPayload] -> Maybe Bool isPressedGamepad joyId button events | any (isEventButton SDL.ControllerButtonPressed button) events = Just True | any (isEventButton SDL.ControllerButtonReleased button) events = Just False | otherwise = Nothing where isEventButton :: SDL.ControllerButtonState -> SDL.ControllerButton -> SDL.EventPayload -> Bool isEventButton expected bu (SDL.ControllerButtonEvent (SDL.ControllerButtonEventData i b state)) | i == joyId = expected == state && bu == b | otherwise = False isEventButton _ _ _ = False