{-|
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, fromMaybe)
import Data.Text (Text)

import qualified Data.Map.Strict as M
import qualified SDL

import Monomer.Common
import Monomer.Event.Keyboard
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 :: EventPayload -> Bool
isActionEvent SDL.MouseButtonEvent{} = Bool
True
isActionEvent SDL.MouseWheelEvent{} = Bool
True
isActionEvent SDL.KeyboardEvent{} = Bool
True
isActionEvent SDL.TextInputEvent{} = Bool
True
isActionEvent EventPayload
_ = Bool
False

-- | Configuration options for converting from an SDL event to a 'SystemEvent'.
data ConvertEventsCfg = ConvertEventsCfg {
  ConvertEventsCfg -> Text
_cecOs :: Text,           -- ^ The host operating system.
  ConvertEventsCfg -> Double
_cecDpr :: Double,        -- ^ Device pixel rate.
  ConvertEventsCfg -> Double
_cecEpr :: Double,        -- ^ Event pixel rate.
  ConvertEventsCfg -> Bool
_cecInvertWheelX :: Bool, -- ^ Whether wheel/trackpad x direction should be inverted.
  ConvertEventsCfg -> Bool
_cecInvertWheelY :: Bool  -- ^ Whether wheel/trackpad y direction should be inverted.
} deriving (ConvertEventsCfg -> ConvertEventsCfg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConvertEventsCfg -> ConvertEventsCfg -> Bool
$c/= :: ConvertEventsCfg -> ConvertEventsCfg -> Bool
== :: ConvertEventsCfg -> ConvertEventsCfg -> Bool
$c== :: ConvertEventsCfg -> ConvertEventsCfg -> Bool
Eq, Int -> ConvertEventsCfg -> ShowS
[ConvertEventsCfg] -> ShowS
ConvertEventsCfg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConvertEventsCfg] -> ShowS
$cshowList :: [ConvertEventsCfg] -> ShowS
show :: ConvertEventsCfg -> String
$cshow :: ConvertEventsCfg -> String
showsPrec :: Int -> ConvertEventsCfg -> ShowS
$cshowsPrec :: Int -> ConvertEventsCfg -> ShowS
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 :: ConvertEventsCfg -> Point -> [EventPayload] -> [SystemEvent]
convertEvents ConvertEventsCfg
cfg Point
mousePos [EventPayload]
events = forall a. [Maybe a] -> [a]
catMaybes [Maybe SystemEvent]
convertedEvents where
  ConvertEventsCfg Text
os Double
dpr Double
epr Bool
invertX Bool
invertY = ConvertEventsCfg
cfg
  convertedEvents :: [Maybe SystemEvent]
convertedEvents = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EventPayload -> Maybe SystemEvent
convertEvent [EventPayload]
events
  convertEvent :: EventPayload -> Maybe SystemEvent
convertEvent EventPayload
evt =
    Point -> EventPayload -> Maybe SystemEvent
mouseMoveEvent Point
mousePos EventPayload
evt
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Point -> EventPayload -> Maybe SystemEvent
mouseClick Point
mousePos EventPayload
evt
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConvertEventsCfg -> Point -> EventPayload -> Maybe SystemEvent
mouseWheelEvent ConvertEventsCfg
cfg Point
mousePos EventPayload
evt
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Point -> EventPayload -> Maybe SystemEvent
mouseMoveLeave Point
mousePos EventPayload
evt
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EventPayload -> Maybe SystemEvent
keyboardEvent EventPayload
evt
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EventPayload -> Maybe SystemEvent
textEvent EventPayload
evt

-- | Adds a given offset to mouse related SystemEvents.
translateEvent
  :: Point        -- ^ Offset to apply
  -> SystemEvent  -- ^ Source SystemEvent
  -> SystemEvent  -- ^ Updated SystemEvent
translateEvent :: Point -> SystemEvent -> SystemEvent
translateEvent Point
offset SystemEvent
evt = case SystemEvent
evt of
  Click Point
p Button
btn Int
cl -> Point -> Button -> Int -> SystemEvent
Click (Point -> Point -> Point
addPoint Point
p Point
offset) Button
btn Int
cl
  ButtonAction Point
p Button
btn ButtonState
st Int
cl -> Point -> Button -> ButtonState -> Int -> SystemEvent
ButtonAction (Point -> Point -> Point
addPoint Point
p Point
offset) Button
btn ButtonState
st Int
cl
  WheelScroll Point
p Point
wxy WheelDirection
dir -> Point -> Point -> WheelDirection -> SystemEvent
WheelScroll (Point -> Point -> Point
addPoint Point
p Point
offset) Point
wxy WheelDirection
dir
  Enter Point
p -> Point -> SystemEvent
Enter (Point -> Point -> Point
addPoint Point
p Point
offset)
  Move Point
p -> Point -> SystemEvent
Move (Point -> Point -> Point
addPoint Point
p Point
offset)
  Leave Point
p -> Point -> SystemEvent
Leave (Point -> Point -> Point
addPoint Point
p Point
offset)
  Drag Point
p Path
path WidgetDragMsg
msg -> Point -> Path -> WidgetDragMsg -> SystemEvent
Drag (Point -> Point -> Point
addPoint Point
p Point
offset) Path
path WidgetDragMsg
msg
  Drop Point
p Path
path WidgetDragMsg
msg -> Point -> Path -> WidgetDragMsg -> SystemEvent
Drop (Point -> Point -> Point
addPoint Point
p Point
offset) Path
path WidgetDragMsg
msg
  SystemEvent
_ -> SystemEvent
evt

mouseClick :: Point -> SDL.EventPayload -> Maybe SystemEvent
mouseClick :: Point -> EventPayload -> Maybe SystemEvent
mouseClick Point
mousePos (SDL.MouseButtonEvent MouseButtonEventData
eventData) = Maybe SystemEvent
systemEvent where
    button :: Maybe Button
button = case MouseButtonEventData -> MouseButton
SDL.mouseButtonEventButton MouseButtonEventData
eventData of
      MouseButton
SDL.ButtonLeft -> forall a. a -> Maybe a
Just Button
BtnLeft
      MouseButton
SDL.ButtonRight -> forall a. a -> Maybe a
Just Button
BtnRight
      MouseButton
SDL.ButtonMiddle -> forall a. a -> Maybe a
Just Button
BtnMiddle
      MouseButton
_ -> forall a. Maybe a
Nothing

    action :: ButtonState
action = case MouseButtonEventData -> InputMotion
SDL.mouseButtonEventMotion MouseButtonEventData
eventData of
      InputMotion
SDL.Pressed -> ButtonState
BtnPressed
      InputMotion
SDL.Released -> ButtonState
BtnReleased

    clicks :: Int
clicks = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ MouseButtonEventData -> Word8
SDL.mouseButtonEventClicks MouseButtonEventData
eventData
    systemEvent :: Maybe SystemEvent
systemEvent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Button
btn -> Point -> Button -> ButtonState -> Int -> SystemEvent
ButtonAction Point
mousePos Button
btn ButtonState
action Int
clicks) Maybe Button
button
mouseClick Point
_ EventPayload
_ = forall a. Maybe a
Nothing

mouseMoveEvent :: Point -> SDL.EventPayload -> Maybe SystemEvent
mouseMoveEvent :: Point -> EventPayload -> Maybe SystemEvent
mouseMoveEvent Point
mousePos (SDL.MouseMotionEvent MouseMotionEventData
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Point -> SystemEvent
Move Point
mousePos
mouseMoveEvent Point
mousePos EventPayload
_ = forall a. Maybe a
Nothing

mouseMoveLeave :: Point -> SDL.EventPayload -> Maybe SystemEvent
mouseMoveLeave :: Point -> EventPayload -> Maybe SystemEvent
mouseMoveLeave Point
mousePos SDL.WindowLostMouseFocusEvent{} = Maybe SystemEvent
evt where
  evt :: Maybe SystemEvent
evt = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Point -> SystemEvent
Move (Double -> Double -> Point
Point (-Double
1) (-Double
1))
mouseMoveLeave Point
mousePos EventPayload
_ = forall a. Maybe a
Nothing

mouseWheelEvent :: ConvertEventsCfg -> Point -> SDL.EventPayload -> Maybe SystemEvent
mouseWheelEvent :: ConvertEventsCfg -> Point -> EventPayload -> Maybe SystemEvent
mouseWheelEvent ConvertEventsCfg
cfg Point
pos (SDL.MouseWheelEvent MouseWheelEventData
eventData) = Maybe SystemEvent
systemEvent where
  ConvertEventsCfg Text
os Double
dpr Double
epr Bool
invertX Bool
invertY = ConvertEventsCfg
cfg
  signX :: Double
signX = if Bool
invertX then -Double
1 else Double
1
  signY :: Double
signY = if Bool
invertY then -Double
1 else Double
1
  factorX :: Double
factorX
    | Text
os forall a. Eq a => a -> a -> Bool
== Text
"Windows" Bool -> Bool -> Bool
|| Text
os forall a. Eq a => a -> a -> Bool
== Text
"Mac OS X" = -Double
signX
    | Bool
otherwise = Double
signX
  factorY :: Double
factorY = Double
signY
  wheelDirection :: WheelDirection
wheelDirection = case MouseWheelEventData -> MouseScrollDirection
SDL.mouseWheelEventDirection MouseWheelEventData
eventData of
    MouseScrollDirection
SDL.ScrollNormal -> WheelDirection
WheelNormal
    MouseScrollDirection
SDL.ScrollFlipped -> WheelDirection
WheelFlipped
  SDL.V2 Int32
x Int32
y = MouseWheelEventData -> V2 Int32
SDL.mouseWheelEventPos MouseWheelEventData
eventData
  wheelDelta :: Point
wheelDelta = Double -> Double -> Point
Point (Double
factorX forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x forall a. Num a => a -> a -> a
* Double
epr) (Double
factorY forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y forall a. Num a => a -> a -> a
* Double
epr)

  systemEvent :: Maybe SystemEvent
systemEvent = case MouseWheelEventData -> MouseDevice
SDL.mouseWheelEventWhich MouseWheelEventData
eventData of
    SDL.Mouse Int
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Point -> Point -> WheelDirection -> SystemEvent
WheelScroll Point
pos Point
wheelDelta WheelDirection
wheelDirection
    MouseDevice
SDL.Touch -> forall a. Maybe a
Nothing
mouseWheelEvent ConvertEventsCfg
cfg Point
mousePos EventPayload
_ = forall a. Maybe a
Nothing

keyboardEvent :: SDL.EventPayload -> Maybe SystemEvent
keyboardEvent :: EventPayload -> Maybe SystemEvent
keyboardEvent (SDL.KeyboardEvent KeyboardEventData
eventData) = forall a. a -> Maybe a
Just SystemEvent
keyAction where
  keySym :: Keysym
keySym = KeyboardEventData -> Keysym
SDL.keyboardEventKeysym KeyboardEventData
eventData
  keyMod :: KeyMod
keyMod = KeyModifier -> KeyMod
convertKeyModifier forall a b. (a -> b) -> a -> b
$ Keysym -> KeyModifier
SDL.keysymModifier Keysym
keySym
  keyCode :: Int32
keyCode = Keycode -> Int32
SDL.unwrapKeycode forall a b. (a -> b) -> a -> b
$ Keysym -> Keycode
SDL.keysymKeycode Keysym
keySym
  keyStatus :: KeyStatus
keyStatus = case KeyboardEventData -> InputMotion
SDL.keyboardEventKeyMotion KeyboardEventData
eventData of
    InputMotion
SDL.Pressed -> KeyStatus
KeyPressed
    InputMotion
SDL.Released -> KeyStatus
KeyReleased
  keyAction :: SystemEvent
keyAction = KeyMod -> KeyCode -> KeyStatus -> SystemEvent
KeyAction KeyMod
keyMod (Int -> KeyCode
KeyCode forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
keyCode) KeyStatus
keyStatus
keyboardEvent EventPayload
_ = forall a. Maybe a
Nothing

textEvent :: SDL.EventPayload -> Maybe SystemEvent
textEvent :: EventPayload -> Maybe SystemEvent
textEvent (SDL.TextInputEvent TextInputEventData
input) = forall a. a -> Maybe a
Just SystemEvent
textInput where
  textInput :: SystemEvent
textInput = Text -> SystemEvent
TextInput (TextInputEventData -> Text
SDL.textInputEventText TextInputEventData
input)
textEvent EventPayload
_ = forall a. Maybe a
Nothing

convertKeyModifier :: SDL.KeyModifier -> KeyMod
convertKeyModifier :: KeyModifier -> KeyMod
convertKeyModifier KeyModifier
keyMod = KeyMod {
  _kmLeftShift :: Bool
_kmLeftShift = KeyModifier -> Bool
SDL.keyModifierLeftShift KeyModifier
keyMod,
  _kmRightShift :: Bool
_kmRightShift = KeyModifier -> Bool
SDL.keyModifierRightShift KeyModifier
keyMod,
  _kmLeftCtrl :: Bool
_kmLeftCtrl = KeyModifier -> Bool
SDL.keyModifierLeftCtrl KeyModifier
keyMod,
  _kmRightCtrl :: Bool
_kmRightCtrl = KeyModifier -> Bool
SDL.keyModifierRightCtrl KeyModifier
keyMod,
  _kmLeftAlt :: Bool
_kmLeftAlt = KeyModifier -> Bool
SDL.keyModifierLeftAlt KeyModifier
keyMod,
  _kmRightAlt :: Bool
_kmRightAlt = KeyModifier -> Bool
SDL.keyModifierRightAlt KeyModifier
keyMod,
  _kmLeftGUI :: Bool
_kmLeftGUI = KeyModifier -> Bool
SDL.keyModifierLeftGUI KeyModifier
keyMod,
  _kmRightGUI :: Bool
_kmRightGUI = KeyModifier -> Bool
SDL.keyModifierRightGUI KeyModifier
keyMod,
  _kmNumLock :: Bool
_kmNumLock = KeyModifier -> Bool
SDL.keyModifierNumLock KeyModifier
keyMod,
  _kmCapsLock :: Bool
_kmCapsLock = KeyModifier -> Bool
SDL.keyModifierCapsLock KeyModifier
keyMod,
  _kmAltGr :: Bool
_kmAltGr = KeyModifier -> Bool
SDL.keyModifierAltGr KeyModifier
keyMod
}