affection/src/Affection/MessageBus/Message/JoystickMessage.hs

module Affection.MessageBus.Message.JoystickMessage 
  ( JoystickMessage(..)
    -- | Vector export
  , Linear.V2
    -- | SDL exports
  , SDL.JoyHatPosition
  , SDL.JoyButtonState
  , SDL.JoyDeviceConnection
    -- | Number exports
  , Word8
  , Int16
  , Int32
  ) where

import Affection.MessageBus.Message.Class

import Data.Word (Word8)
import Data.Int (Int32, Int16)

import qualified SDL

import Linear (V2(..))

-- | Datatype for handling all possible joystick events handed over from sdl2
data JoystickMessage
  -- | Movement of a Joystick axis
  = MsgJoystickAxis
    { msgJAWhen :: Double -- ^ Time of event
    , msgJAWhich :: Int32 -- ^ Joystick identifier
    , msgJAAxis :: Word8  -- ^ Axis identifier
    , msgJAValue :: Int16 -- ^ Axis value
    }
  -- | Movement of a joystick ball controller
  | MsgJoystickBall
    { msgJBWhen :: Double            -- ^ Time of event
    , msgJBWhich :: Int32            -- ^ Joystick identifier
    , msgJBBall :: Word8             -- ^ Ball identifier
    , msgJBRelMotion :: V2 Int16     -- ^ Motion relative to previous position
    }
  -- | Movement of joystick hat controller
  | MsgJoystickHat
    { msgJHWhen :: Double                 -- ^ Time of event
    , msgJHWhich :: Int32                 -- ^ Joystick identifier
    , msgJHHat :: Word8                   -- ^ Hat identifier
    , msgJHPosition :: SDL.JoyHatPosition -- ^ New hat position
    }
  -- | Joystick button event
  | MsgJoystickButton
    { msgJBWhen :: Double              -- ^ Time of event
    , msgJBWhich :: Int32              -- ^ Joystick identifier
    , msgJBButton :: Word8             -- ^ Button identifier
    , msgJBState :: SDL.JoyButtonState -- ^ New Button state
    }
  -- | Joystick device event
  | MsgJoystickDevice
    { msgJDWhen :: Double                        -- ^ Time of event
    , msgJDWhich :: Int32                        -- ^ Joystick identifier
    , msgJDConnection :: SDL.JoyDeviceConnection -- ^ Connection status
    }
  deriving (Show)

instance Message JoystickMessage where
  msgTime (MsgJoystickAxis t _ _ _)   = t
  msgTime (MsgJoystickBall t _ _ _)   = t
  msgTime (MsgJoystickHat t _ _ _)    = t
  msgTime (MsgJoystickButton t _ _ _) = t
  msgTime (MsgJoystickDevice t _ _)   = t