content: {-|
  Module      : Monomer.Event.Core
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Core functions for SDL event processing and conversion.
  -}
  module Monomer.Event.Core (
    ConvertEventsCfg(..),
    isActionEvent,
    convertEvents,
    translateEvent
  ) where
  
  import Control.Applicative ((<|>))
  import Data.Maybe (catMaybes)
  import Data.Text (Text)
  
  import qualified SDL
  
  import Monomer.Common
  import Monomer.Event.Types
  
  {-|
  Checks if an SDL event is an action event. Currently only mouse and keyboard
  events are considered as such (touch events should be added in the future). This
  is used for triggering automatic rendering of a frame. For other events, widgets
  must request rendering explicitly.
  -}
  isActionEvent :: SDL.EventPayload -> Bool
  isActionEvent SDL.MouseButtonEvent{} = True
  isActionEvent SDL.MouseWheelEvent{} = True
  isActionEvent SDL.KeyboardEvent{} = True
  isActionEvent SDL.TextEditingEvent{} = True
  isActionEvent SDL.TextInputEvent{} = True
  isActionEvent _ = False
  
  -- | Configuration options for converting from an SDL event to a 'SystemEvent'.
  data ConvertEventsCfg = ConvertEventsCfg {
    _cecOs :: Text,           -- ^ The host operating system.
    _cecDpr :: Double,        -- ^ Device pixel rate.
    _cecEpr :: Double,        -- ^ Event pixel rate.
    _cecInvertWheelX :: Bool, -- ^ Whether wheel/trackpad x direction should be inverted.
    _cecInvertWheelY :: Bool  -- ^ Whether wheel/trackpad y direction should be inverted.
  } deriving (Eq, Show)
  
  -- | Converts SDL events to Monomer's SystemEvent
  convertEvents
    :: ConvertEventsCfg    -- ^ Settings for event conversion.
    -> Point               -- ^ Mouse position.
    -> [SDL.EventPayload]  -- ^ List of SDL events.
    -> [SystemEvent]       -- ^ List of Monomer events.
  convertEvents cfg mousePos events = catMaybes convertedEvents where
    ConvertEventsCfg os dpr epr invertX invertY = cfg
    convertedEvents = fmap convertEvent events
    convertEvent evt =
      mouseMoveEvent mousePos evt
      <|> mouseClick mousePos evt
      <|> mouseWheelEvent cfg mousePos evt
      <|> mouseMoveLeave mousePos evt
      <|> keyboardEvent evt
      <|> textEvent evt
  
  -- | Adds a given offset to mouse related SystemEvents.
  translateEvent
    :: Point        -- ^ Offset to apply
    -> SystemEvent  -- ^ Source SystemEvent
    -> SystemEvent  -- ^ Updated SystemEvent
  translateEvent offset evt = case evt of
    Click p btn cl -> Click (addPoint p offset) btn cl
    ButtonAction p btn st cl -> ButtonAction (addPoint p offset) btn st cl
    WheelScroll p wxy dir -> WheelScroll (addPoint p offset) wxy dir
    Enter p -> Enter (addPoint p offset)
    Move p -> Move (addPoint p offset)
    Leave p -> Leave (addPoint p offset)
    Drag p path msg -> Drag (addPoint p offset) path msg
    Drop p path msg -> Drop (addPoint p offset) path msg
    _ -> evt
  
  mouseClick :: Point -> SDL.EventPayload -> Maybe SystemEvent
  mouseClick mousePos (SDL.MouseButtonEvent eventData) = systemEvent where
      button = case SDL.mouseButtonEventButton eventData of
        SDL.ButtonLeft -> Just BtnLeft
        SDL.ButtonRight -> Just BtnRight
        SDL.ButtonMiddle -> Just BtnMiddle
        _ -> Nothing
  
      action = case SDL.mouseButtonEventMotion eventData of
        SDL.Pressed -> BtnPressed
        SDL.Released -> BtnReleased
  
      clicks = fromIntegral $ SDL.mouseButtonEventClicks eventData
      systemEvent = fmap (\btn -> ButtonAction mousePos btn action clicks) button
  mouseClick _ _ = Nothing
  
  mouseMoveEvent :: Point -> SDL.EventPayload -> Maybe SystemEvent
  mouseMoveEvent mousePos (SDL.MouseMotionEvent _) = Just $ Move mousePos
  mouseMoveEvent mousePos _ = Nothing
  
  mouseMoveLeave :: Point -> SDL.EventPayload -> Maybe SystemEvent
  mouseMoveLeave mousePos SDL.WindowLostMouseFocusEvent{} = evt where
    evt = Just $ Move (Point (-1) (-1))
  mouseMoveLeave mousePos _ = Nothing
  
  mouseWheelEvent :: ConvertEventsCfg -> Point -> SDL.EventPayload -> Maybe SystemEvent
  mouseWheelEvent cfg pos (SDL.MouseWheelEvent eventData) = systemEvent where
    ConvertEventsCfg os dpr epr invertX invertY = cfg
    signX = if invertX then -1 else 1
    signY = if invertY then -1 else 1
    factorX
      | os == "Windows" || os == "Mac OS X" = -signX
      | otherwise = signX
    factorY = signY
    wheelDirection = case SDL.mouseWheelEventDirection eventData of
      SDL.ScrollNormal -> WheelNormal
      SDL.ScrollFlipped -> WheelFlipped
    SDL.V2 x y = SDL.mouseWheelEventPos eventData
    wheelDelta = Point (factorX * fromIntegral x * epr) (factorY * fromIntegral y * epr)
  
    systemEvent = case SDL.mouseWheelEventWhich eventData of
      SDL.Mouse _ -> Just $ WheelScroll pos wheelDelta wheelDirection
      SDL.Touch -> Nothing
  mouseWheelEvent cfg mousePos _ = Nothing
  
  keyboardEvent :: SDL.EventPayload -> Maybe SystemEvent
  keyboardEvent (SDL.KeyboardEvent eventData) = Just keyAction where
    keySym = SDL.keyboardEventKeysym eventData
    keyMod = convertKeyModifier $ SDL.keysymModifier keySym
    keyCode = SDL.unwrapKeycode $ SDL.keysymKeycode keySym
    keyStatus = case SDL.keyboardEventKeyMotion eventData of
      SDL.Pressed -> KeyPressed
      SDL.Released -> KeyReleased
    keyAction = KeyAction keyMod (KeyCode $ fromIntegral keyCode) keyStatus
  keyboardEvent _ = Nothing
  
  textEvent :: SDL.EventPayload -> Maybe SystemEvent
  textEvent (SDL.TextInputEvent input) = Just textInput where
    textInput = TextInput (SDL.textInputEventText input)
  textEvent _ = Nothing
  
  convertKeyModifier :: SDL.KeyModifier -> KeyMod
  convertKeyModifier keyMod = KeyMod {
    _kmLeftShift = SDL.keyModifierLeftShift keyMod,
    _kmRightShift = SDL.keyModifierRightShift keyMod,
    _kmLeftCtrl = SDL.keyModifierLeftCtrl keyMod,
    _kmRightCtrl = SDL.keyModifierRightCtrl keyMod,
    _kmLeftAlt = SDL.keyModifierLeftAlt keyMod,
    _kmRightAlt = SDL.keyModifierRightAlt keyMod,
    _kmLeftGUI = SDL.keyModifierLeftGUI keyMod,
    _kmRightGUI = SDL.keyModifierRightGUI keyMod,
    _kmNumLock = SDL.keyModifierNumLock keyMod,
    _kmCapsLock = SDL.keyModifierCapsLock keyMod,
    _kmAltGr = SDL.keyModifierAltGr keyMod
  }
  