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
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
data ConvertEventsCfg = ConvertEventsCfg {
ConvertEventsCfg -> Text
_cecOs :: Text,
ConvertEventsCfg -> Double
_cecDpr :: Double,
ConvertEventsCfg -> Double
_cecEpr :: Double,
ConvertEventsCfg -> Bool
_cecInvertWheelX :: Bool,
ConvertEventsCfg -> Bool
_cecInvertWheelY :: Bool
} deriving (ConvertEventsCfg -> ConvertEventsCfg -> Bool
(ConvertEventsCfg -> ConvertEventsCfg -> Bool)
-> (ConvertEventsCfg -> ConvertEventsCfg -> Bool)
-> Eq ConvertEventsCfg
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
(Int -> ConvertEventsCfg -> ShowS)
-> (ConvertEventsCfg -> String)
-> ([ConvertEventsCfg] -> ShowS)
-> Show ConvertEventsCfg
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)
convertEvents
:: ConvertEventsCfg
-> Point
-> [SDL.EventPayload]
-> [SystemEvent]
convertEvents :: ConvertEventsCfg -> Point -> [EventPayload] -> [SystemEvent]
convertEvents ConvertEventsCfg
cfg Point
mousePos [EventPayload]
events = [Maybe SystemEvent] -> [SystemEvent]
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 = (EventPayload -> Maybe SystemEvent)
-> [EventPayload] -> [Maybe SystemEvent]
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
Maybe SystemEvent -> Maybe SystemEvent -> Maybe SystemEvent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Point -> EventPayload -> Maybe SystemEvent
mouseClick Point
mousePos EventPayload
evt
Maybe SystemEvent -> Maybe SystemEvent -> Maybe SystemEvent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConvertEventsCfg -> Point -> EventPayload -> Maybe SystemEvent
mouseWheelEvent ConvertEventsCfg
cfg Point
mousePos EventPayload
evt
Maybe SystemEvent -> Maybe SystemEvent -> Maybe SystemEvent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Point -> EventPayload -> Maybe SystemEvent
mouseMoveLeave Point
mousePos EventPayload
evt
Maybe SystemEvent -> Maybe SystemEvent -> Maybe SystemEvent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EventPayload -> Maybe SystemEvent
keyboardEvent EventPayload
evt
Maybe SystemEvent -> Maybe SystemEvent -> Maybe SystemEvent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EventPayload -> Maybe SystemEvent
textEvent EventPayload
evt
translateEvent
:: Point
-> SystemEvent
-> 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 -> Button -> Maybe Button
forall a. a -> Maybe a
Just Button
BtnLeft
MouseButton
SDL.ButtonRight -> Button -> Maybe Button
forall a. a -> Maybe a
Just Button
BtnRight
MouseButton
SDL.ButtonMiddle -> Button -> Maybe Button
forall a. a -> Maybe a
Just Button
BtnMiddle
MouseButton
_ -> Maybe Button
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 = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ MouseButtonEventData -> Word8
SDL.mouseButtonEventClicks MouseButtonEventData
eventData
systemEvent :: Maybe SystemEvent
systemEvent = (Button -> SystemEvent) -> Maybe Button -> Maybe 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
_ = Maybe SystemEvent
forall a. Maybe a
Nothing
mouseMoveEvent :: Point -> SDL.EventPayload -> Maybe SystemEvent
mouseMoveEvent :: Point -> EventPayload -> Maybe SystemEvent
mouseMoveEvent Point
mousePos (SDL.MouseMotionEvent MouseMotionEventData
_) = SystemEvent -> Maybe SystemEvent
forall a. a -> Maybe a
Just (SystemEvent -> Maybe SystemEvent)
-> SystemEvent -> Maybe SystemEvent
forall a b. (a -> b) -> a -> b
$ Point -> SystemEvent
Move Point
mousePos
mouseMoveEvent Point
mousePos EventPayload
_ = Maybe SystemEvent
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 = SystemEvent -> Maybe SystemEvent
forall a. a -> Maybe a
Just (SystemEvent -> Maybe SystemEvent)
-> SystemEvent -> Maybe SystemEvent
forall a b. (a -> b) -> a -> b
$ Point -> SystemEvent
Move (Double -> Double -> Point
Point (-Double
1) (-Double
1))
mouseMoveLeave Point
mousePos EventPayload
_ = Maybe SystemEvent
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Windows" Bool -> Bool -> Bool
|| Text
os Text -> Text -> Bool
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
epr) (Double
factorY Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
epr)
systemEvent :: Maybe SystemEvent
systemEvent = case MouseWheelEventData -> MouseDevice
SDL.mouseWheelEventWhich MouseWheelEventData
eventData of
SDL.Mouse Int
_ -> SystemEvent -> Maybe SystemEvent
forall a. a -> Maybe a
Just (SystemEvent -> Maybe SystemEvent)
-> SystemEvent -> Maybe SystemEvent
forall a b. (a -> b) -> a -> b
$ Point -> Point -> WheelDirection -> SystemEvent
WheelScroll Point
pos Point
wheelDelta WheelDirection
wheelDirection
MouseDevice
SDL.Touch -> Maybe SystemEvent
forall a. Maybe a
Nothing
mouseWheelEvent ConvertEventsCfg
cfg Point
mousePos EventPayload
_ = Maybe SystemEvent
forall a. Maybe a
Nothing
keyboardEvent :: SDL.EventPayload -> Maybe SystemEvent
keyboardEvent :: EventPayload -> Maybe SystemEvent
keyboardEvent (SDL.KeyboardEvent KeyboardEventData
eventData) = SystemEvent -> Maybe SystemEvent
forall a. a -> Maybe a
Just SystemEvent
keyAction where
keySym :: Keysym
keySym = KeyboardEventData -> Keysym
SDL.keyboardEventKeysym KeyboardEventData
eventData
keyMod :: KeyMod
keyMod = KeyModifier -> KeyMod
convertKeyModifier (KeyModifier -> KeyMod) -> KeyModifier -> KeyMod
forall a b. (a -> b) -> a -> b
$ Keysym -> KeyModifier
SDL.keysymModifier Keysym
keySym
keyCode :: Int32
keyCode = Keycode -> Int32
SDL.unwrapKeycode (Keycode -> Int32) -> Keycode -> Int32
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 (Int -> KeyCode) -> Int -> KeyCode
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
keyCode) KeyStatus
keyStatus
keyboardEvent EventPayload
_ = Maybe SystemEvent
forall a. Maybe a
Nothing
textEvent :: SDL.EventPayload -> Maybe SystemEvent
textEvent :: EventPayload -> Maybe SystemEvent
textEvent (SDL.TextInputEvent TextInputEventData
input) = SystemEvent -> Maybe SystemEvent
forall a. a -> Maybe a
Just SystemEvent
textInput where
textInput :: SystemEvent
textInput = Text -> SystemEvent
TextInput (TextInputEventData -> Text
SDL.textInputEventText TextInputEventData
input)
textEvent EventPayload
_ = Maybe SystemEvent
forall a. Maybe a
Nothing
convertKeyModifier :: SDL.KeyModifier -> KeyMod
convertKeyModifier :: KeyModifier -> KeyMod
convertKeyModifier KeyModifier
keyMod = KeyMod :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> 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
}