module Monomer.Event.Core (
isActionEvent,
convertEvents,
translateEvent
) where
import Control.Applicative ((<|>))
import Data.Maybe (catMaybes, fromMaybe)
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
convertEvents
:: Double
-> Double
-> Point
-> [SDL.EventPayload]
-> [SystemEvent]
convertEvents :: Double -> Double -> Point -> [EventPayload] -> [SystemEvent]
convertEvents Double
dpr Double
epr Point
mousePos [EventPayload]
events = [Maybe SystemEvent] -> [SystemEvent]
forall a. [Maybe a] -> [a]
catMaybes [Maybe SystemEvent]
convertedEvents where
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
<|> Double -> Point -> EventPayload -> Maybe SystemEvent
mouseWheelEvent Double
epr 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
_ -> 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 :: Double -> Point -> SDL.EventPayload -> Maybe SystemEvent
mouseWheelEvent :: Double -> Point -> EventPayload -> Maybe SystemEvent
mouseWheelEvent Double
epr Point
mousePos (SDL.MouseWheelEvent MouseWheelEventData
eventData) = Maybe SystemEvent
systemEvent where
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 (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) (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
mousePos Point
wheelDelta WheelDirection
wheelDirection
MouseDevice
SDL.Touch -> Maybe SystemEvent
forall a. Maybe a
Nothing
mouseWheelEvent Double
epr 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
}