{-|
Module      : Monomer.Event.Types
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Basic types for Monomer events.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}

module Monomer.Event.Types where

import Data.Default
import Data.Text (Text)
import Data.Typeable (Typeable, cast, typeOf)
import Data.Map.Strict (Map)

import qualified Data.Map.Strict as M

import Monomer.Common

-- | Keycode for keyboard events. Used instead of Scancodes to avoid mappings.
newtype KeyCode
  = KeyCode { KeyCode -> Int
unKeyCode :: Int }
  deriving (KeyCode -> KeyCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyCode -> KeyCode -> Bool
$c/= :: KeyCode -> KeyCode -> Bool
== :: KeyCode -> KeyCode -> Bool
$c== :: KeyCode -> KeyCode -> Bool
Eq, Eq KeyCode
KeyCode -> KeyCode -> Bool
KeyCode -> KeyCode -> Ordering
KeyCode -> KeyCode -> KeyCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyCode -> KeyCode -> KeyCode
$cmin :: KeyCode -> KeyCode -> KeyCode
max :: KeyCode -> KeyCode -> KeyCode
$cmax :: KeyCode -> KeyCode -> KeyCode
>= :: KeyCode -> KeyCode -> Bool
$c>= :: KeyCode -> KeyCode -> Bool
> :: KeyCode -> KeyCode -> Bool
$c> :: KeyCode -> KeyCode -> Bool
<= :: KeyCode -> KeyCode -> Bool
$c<= :: KeyCode -> KeyCode -> Bool
< :: KeyCode -> KeyCode -> Bool
$c< :: KeyCode -> KeyCode -> Bool
compare :: KeyCode -> KeyCode -> Ordering
$ccompare :: KeyCode -> KeyCode -> Ordering
Ord, Int -> KeyCode -> ShowS
[KeyCode] -> ShowS
KeyCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyCode] -> ShowS
$cshowList :: [KeyCode] -> ShowS
show :: KeyCode -> String
$cshow :: KeyCode -> String
showsPrec :: Int -> KeyCode -> ShowS
$cshowsPrec :: Int -> KeyCode -> ShowS
Show)

-- | Status of a keyboard key.
data KeyStatus
  = KeyPressed
  | KeyReleased
  deriving (KeyStatus -> KeyStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyStatus -> KeyStatus -> Bool
$c/= :: KeyStatus -> KeyStatus -> Bool
== :: KeyStatus -> KeyStatus -> Bool
$c== :: KeyStatus -> KeyStatus -> Bool
Eq, Int -> KeyStatus -> ShowS
[KeyStatus] -> ShowS
KeyStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyStatus] -> ShowS
$cshowList :: [KeyStatus] -> ShowS
show :: KeyStatus -> String
$cshow :: KeyStatus -> String
showsPrec :: Int -> KeyStatus -> ShowS
$cshowsPrec :: Int -> KeyStatus -> ShowS
Show)

-- | Button of a pointer device (mouse).
data Button
  = BtnLeft
  | BtnMiddle
  | BtnRight
  deriving (Button -> Button -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Button -> Button -> Bool
$c/= :: Button -> Button -> Bool
== :: Button -> Button -> Bool
$c== :: Button -> Button -> Bool
Eq, Int -> Button -> ShowS
[Button] -> ShowS
Button -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Button] -> ShowS
$cshowList :: [Button] -> ShowS
show :: Button -> String
$cshow :: Button -> String
showsPrec :: Int -> Button -> ShowS
$cshowsPrec :: Int -> Button -> ShowS
Show, Eq Button
Button -> Button -> Bool
Button -> Button -> Ordering
Button -> Button -> Button
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Button -> Button -> Button
$cmin :: Button -> Button -> Button
max :: Button -> Button -> Button
$cmax :: Button -> Button -> Button
>= :: Button -> Button -> Bool
$c>= :: Button -> Button -> Bool
> :: Button -> Button -> Bool
$c> :: Button -> Button -> Bool
<= :: Button -> Button -> Bool
$c<= :: Button -> Button -> Bool
< :: Button -> Button -> Bool
$c< :: Button -> Button -> Bool
compare :: Button -> Button -> Ordering
$ccompare :: Button -> Button -> Ordering
Ord)

-- | Status of a mouse button.
data ButtonState
  = BtnPressed
  | BtnReleased
  deriving (ButtonState -> ButtonState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ButtonState -> ButtonState -> Bool
$c/= :: ButtonState -> ButtonState -> Bool
== :: ButtonState -> ButtonState -> Bool
$c== :: ButtonState -> ButtonState -> Bool
Eq, Int -> ButtonState -> ShowS
[ButtonState] -> ShowS
ButtonState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ButtonState] -> ShowS
$cshowList :: [ButtonState] -> ShowS
show :: ButtonState -> String
$cshow :: ButtonState -> String
showsPrec :: Int -> ButtonState -> ShowS
$cshowsPrec :: Int -> ButtonState -> ShowS
Show)

-- | Movement direction in which wheel values are positive.
data WheelDirection
  = WheelNormal
  | WheelFlipped
  deriving (WheelDirection -> WheelDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WheelDirection -> WheelDirection -> Bool
$c/= :: WheelDirection -> WheelDirection -> Bool
== :: WheelDirection -> WheelDirection -> Bool
$c== :: WheelDirection -> WheelDirection -> Bool
Eq, Int -> WheelDirection -> ShowS
[WheelDirection] -> ShowS
WheelDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WheelDirection] -> ShowS
$cshowList :: [WheelDirection] -> ShowS
show :: WheelDirection -> String
$cshow :: WheelDirection -> String
showsPrec :: Int -> WheelDirection -> ShowS
$cshowsPrec :: Int -> WheelDirection -> ShowS
Show)

-- | Types of clipboard content.
data ClipboardData
  = ClipboardEmpty
  | ClipboardText Text
  deriving (ClipboardData -> ClipboardData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClipboardData -> ClipboardData -> Bool
$c/= :: ClipboardData -> ClipboardData -> Bool
== :: ClipboardData -> ClipboardData -> Bool
$c== :: ClipboardData -> ClipboardData -> Bool
Eq, Int -> ClipboardData -> ShowS
[ClipboardData] -> ShowS
ClipboardData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClipboardData] -> ShowS
$cshowList :: [ClipboardData] -> ShowS
show :: ClipboardData -> String
$cshow :: ClipboardData -> String
showsPrec :: Int -> ClipboardData -> ShowS
$cshowsPrec :: Int -> ClipboardData -> ShowS
Show)

-- | Constraints for drag event messages.
type DragMsg i = (Eq i, Typeable i)

-- | Drag message container.
data WidgetDragMsg
  = forall i . DragMsg i => WidgetDragMsg i

instance Eq WidgetDragMsg where
  WidgetDragMsg i
d1 == :: WidgetDragMsg -> WidgetDragMsg -> Bool
== WidgetDragMsg i
d2 = case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast i
d1 of
    Just i
d -> i
d forall a. Eq a => a -> a -> Bool
== i
d2
    Maybe i
_ -> Bool
False

instance Show WidgetDragMsg where
  show :: WidgetDragMsg -> String
show (WidgetDragMsg i
info) = String
"WidgetDragMsg: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf i
info)

-- | Supported Monomer SystemEvents
data SystemEvent
  {-|
  Click (press and release) of a mouse button. Includes mouse position and click
  count.
  -}
  = Click Point Button Int
  {-|
  Click or release of a mouse button. Includes times pressed/released and mouse
  position.
  -}
  | ButtonAction Point Button ButtonState Int
  -- | Mouse wheel movement. Includes mouse position, move size in both axes and
  --   wheel direction.
  | WheelScroll Point Point WheelDirection
  -- | Keyboard key action. Includes modifiers, keyCode and pressed/released.
  --   This event should not be used for text input.
  | KeyAction KeyMod KeyCode KeyStatus
  -- | Processed keyboard events. Some Unicode characters require several key
  --   presses to produce the result. This event provides the final result.
  | TextInput Text
  -- | Provides current clipboard contents to a requesting widget.
  | Clipboard ClipboardData
  -- | Target now has focus. Includes path of the previously focused widget.
  | Focus Path
  -- | Target has lost focus. Includes path of the next focused widget.
  | Blur Path
  -- | Mouse has entered the assigned viewport.
  | Enter Point
  -- | Mouse has moved inside the assigned viewport. This event keeps being
  --   received if the main mouse button is pressed, even if the mouse is
  --   outside the assigned bounds or even the window.
  | Move Point
  -- | Mouse has left the assigned viewport. This event is not received until
  --   the main mouse button has been pressed.
  | Leave Point
  -- | A drag action is active and the mouse is inside the current viewport. The
  --   messsage can be used to decide if it applies to the current widget. This
  --   event is not received by the widget which initiated the drag action, even
  --   if dragging over it.
  | Drag Point Path WidgetDragMsg
  -- | A drag action was active and the main button was released inside the
  --   current viewport.
  | Drop Point Path WidgetDragMsg
  deriving (SystemEvent -> SystemEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemEvent -> SystemEvent -> Bool
$c/= :: SystemEvent -> SystemEvent -> Bool
== :: SystemEvent -> SystemEvent -> Bool
$c== :: SystemEvent -> SystemEvent -> Bool
Eq, Int -> SystemEvent -> ShowS
[SystemEvent] -> ShowS
SystemEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemEvent] -> ShowS
$cshowList :: [SystemEvent] -> ShowS
show :: SystemEvent -> String
$cshow :: SystemEvent -> String
showsPrec :: Int -> SystemEvent -> ShowS
$cshowsPrec :: Int -> SystemEvent -> ShowS
Show)

-- | Status of input devices.
data InputStatus = InputStatus {
  -- | Mouse position.
  InputStatus -> Point
_ipsMousePos :: Point,
  -- | Previous mouse position.
  InputStatus -> Point
_ipsMousePosPrev :: Point,
  -- | Current key modifiers (shift, ctrl, alt, etc).
  InputStatus -> KeyMod
_ipsKeyMod :: KeyMod,
  -- | Current status of keyCodes. If not in the map, status is KeyReleased.
  InputStatus -> Map KeyCode KeyStatus
_ipsKeys :: Map KeyCode KeyStatus,
  -- | Status of mouse buttons. If not in the map, status is BtnReleased.
  InputStatus -> Map Button ButtonState
_ipsButtons :: Map Button ButtonState
} deriving (InputStatus -> InputStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputStatus -> InputStatus -> Bool
$c/= :: InputStatus -> InputStatus -> Bool
== :: InputStatus -> InputStatus -> Bool
$c== :: InputStatus -> InputStatus -> Bool
Eq, Int -> InputStatus -> ShowS
[InputStatus] -> ShowS
InputStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputStatus] -> ShowS
$cshowList :: [InputStatus] -> ShowS
show :: InputStatus -> String
$cshow :: InputStatus -> String
showsPrec :: Int -> InputStatus -> ShowS
$cshowsPrec :: Int -> InputStatus -> ShowS
Show)

instance Default InputStatus where
  def :: InputStatus
def = InputStatus {
    _ipsMousePos :: Point
_ipsMousePos = Double -> Double -> Point
Point (-Double
1) (-Double
1),
    _ipsMousePosPrev :: Point
_ipsMousePosPrev = Double -> Double -> Point
Point (-Double
1) (-Double
1),
    _ipsKeyMod :: KeyMod
_ipsKeyMod = forall a. Default a => a
def,
    _ipsKeys :: Map KeyCode KeyStatus
_ipsKeys = forall k a. Map k a
M.empty,
    _ipsButtons :: Map Button ButtonState
_ipsButtons = forall k a. Map k a
M.empty
  }

{-|
Keyboard modifiers. True indicates the key is pressed.

Note: The __fn__ function in Macs cannot be detected individually.
-}
data KeyMod = KeyMod {
  KeyMod -> Bool
_kmLeftShift :: Bool,
  KeyMod -> Bool
_kmRightShift :: Bool,
  KeyMod -> Bool
_kmLeftCtrl :: Bool,
  KeyMod -> Bool
_kmRightCtrl :: Bool,
  KeyMod -> Bool
_kmLeftAlt :: Bool,
  KeyMod -> Bool
_kmRightAlt :: Bool,
  KeyMod -> Bool
_kmLeftGUI :: Bool,
  KeyMod -> Bool
_kmRightGUI :: Bool,
  KeyMod -> Bool
_kmNumLock :: Bool,
  KeyMod -> Bool
_kmCapsLock :: Bool,
  KeyMod -> Bool
_kmAltGr :: Bool
} deriving (KeyMod -> KeyMod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyMod -> KeyMod -> Bool
$c/= :: KeyMod -> KeyMod -> Bool
== :: KeyMod -> KeyMod -> Bool
$c== :: KeyMod -> KeyMod -> Bool
Eq, Int -> KeyMod -> ShowS
[KeyMod] -> ShowS
KeyMod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyMod] -> ShowS
$cshowList :: [KeyMod] -> ShowS
show :: KeyMod -> String
$cshow :: KeyMod -> String
showsPrec :: Int -> KeyMod -> ShowS
$cshowsPrec :: Int -> KeyMod -> ShowS
Show)

instance Default KeyMod where
  def :: KeyMod
def = KeyMod {
    _kmLeftShift :: Bool
_kmLeftShift = Bool
False,
    _kmRightShift :: Bool
_kmRightShift = Bool
False,
    _kmLeftCtrl :: Bool
_kmLeftCtrl = Bool
False,
    _kmRightCtrl :: Bool
_kmRightCtrl = Bool
False,
    _kmLeftAlt :: Bool
_kmLeftAlt = Bool
False,
    _kmRightAlt :: Bool
_kmRightAlt = Bool
False,
    _kmLeftGUI :: Bool
_kmLeftGUI = Bool
False,
    _kmRightGUI :: Bool
_kmRightGUI = Bool
False,
    _kmNumLock :: Bool
_kmNumLock = Bool
False,
    _kmCapsLock :: Bool
_kmCapsLock = Bool
False,
    _kmAltGr :: Bool
_kmAltGr = Bool
False
  }