module Affection.MessageBus.Message.MouseMessage
  ( MouseMessage(..)
  -- | SDL reexports
  , SDL.Window
  , SDL.MouseDevice
  , SDL.MouseButton
  , SDL.InputMotion
  , SDL.MouseScrollDirection
  ) where

import Affection.MessageBus.Message.Class

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

import qualified SDL

import Linear (V2(..))

-- Datatype for handling mouse events handed down from SDL2
data MouseMessage
  -- | Mouse motion event
  = MsgMouseMotion
    { msgMMWhen :: Double             -- ^ Message time
    , msgMMWindow :: Maybe SDL.Window -- ^ Focused window (if any)
    , msgMMWhich :: SDL.MouseDevice   -- ^ Mouse device identifier
    , msgMMState :: [SDL.MouseButton] -- ^ List of pressed mouse buttons
    , msgMMPos :: V2 Int32            -- ^ Absolute mouse positiom
    , msgMMRelMotion :: V2 Int32      -- ^ Mouse movement relative to previous position
    }
  -- | Mouse button event
  | MsgMouseButton
    { msgMBWhen :: Double             -- ^ Message time
    , msgMBWindow :: Maybe SDL.Window -- ^ Focused window (if any)
    , msgMBMotion :: SDL.InputMotion  -- ^ Button's input motion
    , msgMBWhich :: SDL.MouseDevice   -- ^ Mouse device identifier
    , msgMBButton :: SDL.MouseButton  -- ^ Affected mouse button
    , msgMBClicks :: Word8            -- ^ Number of clicks
    , msgMBPos :: V2 Int32            -- ^ Absolute mouse position
    }
  -- | Mouse wheel event
  | MsgMouseWheel
    { msgMWWhen :: Double                        -- ^ Message time
    , msgMWWhindow :: Maybe SDL.Window           -- ^ Focused window (if any)
    , msgMWWhich :: SDL.MouseDevice              -- ^ Mouse device identifier
    , msgMWPos :: V2 Int32                       -- ^ Absolute mouse position
    , msgMWDIrection :: SDL.MouseScrollDirection -- ^ Scroll direction
    }
  deriving (Show)

instance Message MouseMessage where
  msgTime (MsgMouseMotion t _ _ _ _ _) = t
  msgTime (MsgMouseButton t _ _ _ _ _ _) = t
  msgTime (MsgMouseWheel t _ _ _ _) = t