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

Handlers for WidgetRequests. Functions in this module handle focus, clipboard,
overlays and all SystemEvent related operations and updates.
-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE Strict #-}

module Monomer.Main.Handlers (
  HandlerStep,
  handleSystemEvents,
  handleResourcesInit,
  handleWidgetInit,
  handleWidgetDispose,
  handleWidgetResult,
  handleRequests,
  handleResizeWidgets
) where

import Control.Concurrent.Async (async)
import Control.Lens
  ((&), (^.), (^?), (.~), (?~), (%~), (.=), (?=), (%=), (%%~), _Just, _1, _2, ix, at, use)
import Control.Monad.STM (atomically)
import Control.Concurrent.STM.TChan (TChan, newTChanIO, readTChan, writeTChan)
import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.IO.Class
import Data.Default
import Data.Foldable (fold, toList)
import Data.Maybe
import Data.Sequence (Seq(..), (|>))
import Data.Text (Text)
import Data.Typeable (Typeable, typeOf)
import SDL (($=))

import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified SDL
import qualified SDL.Raw.Enum as SDLEnum
import qualified SDL.Raw.Event as SDLE
import qualified SDL.Raw.Types as SDLT

import Monomer.Core
import Monomer.Event
import Monomer.Graphics
import Monomer.Helper (headMay, putStrLnErr, seqStartsWith)
import Monomer.Main.Types
import Monomer.Main.Util

import qualified Monomer.Lens as L

{-|
Tuple representing the current widget environment, widget root and accumulated
WidgetRequests. These requests have already been processed, they are collected
for unit testing purposes.
-}
type HandlerStep s e = (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))

{-|
Processes a list of SystemEvents dispatching each of the to the corresponding
widget based on the current root. At each step the root may change, new events
may be generated (which will be processed interleaved with the list of events)
and this is handled before returning the latest "HandlerStep".
-}
handleSystemEvents
  :: MonomerM s e m
  => WidgetEnv s e       -- ^ The initial widget environment.
  -> WidgetNode s e      -- ^ The initial widget root.
  -> [SystemEvent]       -- ^ The starting list of events.
  -> m (HandlerStep s e) -- ^ The resulting "HandlerStep."
handleSystemEvents :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> [SystemEvent] -> m (HandlerStep s e)
handleSystemEvents WidgetEnv s e
wenv WidgetNode s e
widgetRoot [SystemEvent]
baseEvents = m (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
nextStep where
  mainBtn :: Button
mainBtn = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainButton s a => Lens' s a
L.mainButton
  reduceEvt :: (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
-> SystemEvent
-> m (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
reduceEvt (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
curStep SystemEvent
evt = do
    let (WidgetEnv s e
curWenv, WidgetNode s e
curRoot, Seq (WidgetRequest s e)
curReqs) = (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
curStep
    [(SystemEvent, Maybe Path)]
systemEvents <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> Button
-> WidgetNode s e
-> SystemEvent
-> m [(SystemEvent, Maybe Path)]
addRelatedEvents WidgetEnv s e
curWenv Button
mainBtn WidgetNode s e
curRoot SystemEvent
evt

    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *} {s} {e}.
(MonadIO m, MonadCatch m, Eq s, MonadState (MonomerCtx s e) m) =>
(WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
-> (SystemEvent, Maybe Path)
-> m (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
reduceSysEvt (WidgetEnv s e
curWenv, WidgetNode s e
curRoot, Seq (WidgetRequest s e)
curReqs) [(SystemEvent, Maybe Path)]
systemEvents
  reduceSysEvt :: (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
-> (SystemEvent, Maybe Path)
-> m (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
reduceSysEvt (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
curStep (SystemEvent
evt, Maybe Path
evtTarget) = do
    Path
focused <- forall s e (m :: * -> *). MonomerM s e m => m Path
getFocusedPath
    let (WidgetEnv s e
curWenv, WidgetNode s e
curRoot, Seq (WidgetRequest s e)
curReqs) = (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
curStep
    let target :: Path
target = forall a. a -> Maybe a -> a
fromMaybe Path
focused Maybe Path
evtTarget
    let curWidget :: Widget s e
curWidget = WidgetNode s e
curRoot forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
    let targetWni :: Maybe WidgetNodeInfo
targetWni = Maybe Path
evtTarget forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Maybe WidgetNodeInfo
findChildNodeInfoByPath WidgetEnv s e
curWenv WidgetNode s e
curRoot
    let targetWid :: Maybe WidgetId
targetWid = (forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe WidgetNodeInfo
targetWni

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SystemEvent -> Bool
isOnEnter SystemEvent
evt) forall a b. (a -> b) -> a -> b
$
      forall s a. HasHoveredWidgetId s a => Lens' s a
L.hoveredWidgetId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe WidgetId
targetWid

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SystemEvent -> Bool
isOnMove SystemEvent
evt)
      forall s e (m :: * -> *). MonomerM s e m => m ()
restoreCursorOnWindowEnter

    Maybe (Path, CursorIcon)
cursorIcon <- forall s e (m :: * -> *).
MonomerM s e m =>
m (Maybe (Path, CursorIcon))
getCurrentCursorIcon
    Maybe Path
hoveredPath <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getHoveredPath
    Maybe (Path, Point)
mainBtnPress <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress
    InputStatus
inputStatus <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasInputStatus s a => Lens' s a
L.inputStatus

    let tmpWenv :: WidgetEnv s e
tmpWenv = WidgetEnv s e
curWenv
          forall a b. a -> (a -> b) -> b
& forall s a. HasCursor s a => Lens' s a
L.cursor forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Path, CursorIcon)
cursorIcon
          forall a b. a -> (a -> b) -> b
& forall s a. HasHoveredPath s a => Lens' s a
L.hoveredPath forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Path
hoveredPath
          forall a b. a -> (a -> b) -> b
& forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Path, Point)
mainBtnPress
          forall a b. a -> (a -> b) -> b
& forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ InputStatus
inputStatus
    let findBranchByPath :: Path -> Seq WidgetNodeInfo
findBranchByPath Path
path = forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
findChildBranchByPath WidgetEnv s e
tmpWenv WidgetNode s e
curRoot Path
path
    let newWenv :: WidgetEnv s e
newWenv = WidgetEnv s e
tmpWenv
          forall a b. a -> (a -> b) -> b
& forall s a. HasFindBranchByPath s a => Lens' s a
L.findBranchByPath forall s t a b. ASetter s t a b -> b -> s -> t
.~ Path -> Seq WidgetNodeInfo
findBranchByPath
    (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs2) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> SystemEvent -> Path -> m (HandlerStep s e)
handleSystemEvent WidgetEnv s e
newWenv WidgetNode s e
curRoot SystemEvent
evt Path
target

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SystemEvent -> Bool
isOnLeave SystemEvent
evt) forall a b. (a -> b) -> a -> b
$ do
      forall s e (m :: * -> *).
MonomerM s e m =>
SystemEvent -> HandlerStep s e -> m ()
resetCursorOnNodeLeave SystemEvent
evt (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
curStep
      forall s a. HasHoveredWidgetId s a => Lens' s a
L.hoveredWidgetId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing

    forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
curReqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs2)
  newEvents :: [SystemEvent]
newEvents = [SystemEvent] -> [SystemEvent]
preProcessEvents [SystemEvent]
baseEvents
  nextStep :: m (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
nextStep = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *} {s} {e}.
(Eq s, MonadState (MonomerCtx s e) m, MonadCatch m, MonadIO m) =>
(WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
-> SystemEvent
-> m (WidgetEnv s e, WidgetNode s e, Seq (WidgetRequest s e))
reduceEvt (WidgetEnv s e
wenv, WidgetNode s e
widgetRoot, forall a. Seq a
Seq.empty) [SystemEvent]
newEvents

-- | Processes a single SystemEvent.
handleSystemEvent
  :: MonomerM s e m
  => WidgetEnv s e
  -> WidgetNode s e
  -> SystemEvent
  -> Path
  -> m (HandlerStep s e)
handleSystemEvent :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> SystemEvent -> Path -> m (HandlerStep s e)
handleSystemEvent WidgetEnv s e
wenv WidgetNode s e
widgetRoot SystemEvent
event Path
currentTarget = do
  Maybe (Path, Point)
mainStart <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress
  Maybe Path
overlay <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getOverlayPath
  Bool
leaveEnterPair <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasLeaveEnterPair s a => Lens' s a
L.leaveEnterPair
  let pressed :: Maybe Path
pressed = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Maybe (Path, Point)
mainStart

  case forall s e.
WidgetEnv s e
-> WidgetNode s e
-> Maybe Path
-> Maybe Path
-> Path
-> SystemEvent
-> Maybe Path
getTargetPath WidgetEnv s e
wenv WidgetNode s e
widgetRoot Maybe Path
pressed Maybe Path
overlay Path
currentTarget SystemEvent
event of
    Maybe Path
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv, WidgetNode s e
widgetRoot, forall a. Seq a
Seq.empty)
    Just Path
target -> do
      let widget :: Widget s e
widget = WidgetNode s e
widgetRoot forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
      let emptyResult :: WidgetResult s e
emptyResult = forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
widgetRoot forall a. Seq a
Seq.empty
      let evtResult :: Maybe (WidgetResult s e)
evtResult = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
widgetHandleEvent Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
widgetRoot Path
target SystemEvent
event
      let resizeWidgets :: Bool
resizeWidgets = Bool -> Bool
not (Bool
leaveEnterPair Bool -> Bool -> Bool
&& SystemEvent -> Bool
isOnLeave SystemEvent
event)
      let widgetResult :: WidgetResult s e
widgetResult = forall a. a -> Maybe a -> a
fromMaybe WidgetResult s e
emptyResult Maybe (WidgetResult s e)
evtResult
            forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall s e.
SystemEvent -> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
addFocusReq SystemEvent
event

      HandlerStep s e
step <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e -> Bool -> WidgetResult s e -> m (HandlerStep s e)
handleWidgetResult WidgetEnv s e
wenv Bool
resizeWidgets WidgetResult s e
widgetResult

      if SystemEvent -> Bool
isOnDrop SystemEvent
event
        then forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleFinalizeDrop HandlerStep s e
step
        else forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step

-- | Initializes system resources (currently only icons).
handleResourcesInit :: MonomerM s e m => m ()
handleResourcesInit :: forall s e (m :: * -> *). MonomerM s e m => m ()
handleResourcesInit = do
  Map CursorIcon Cursor
cursors <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
MonadIO m =>
Map CursorIcon Cursor -> CursorIcon -> m (Map CursorIcon Cursor)
insert forall k a. Map k a
Map.empty [forall a. Enum a => Int -> a
toEnum Int
0 ..]
  forall s a. HasCursorIcons s a => Lens' s a
L.cursorIcons forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map CursorIcon Cursor
cursors
  where
    insert :: Map CursorIcon Cursor -> CursorIcon -> m (Map CursorIcon Cursor)
insert Map CursorIcon Cursor
map CursorIcon
icon = do
      Cursor
cursor <- forall (m :: * -> *). MonadIO m => SystemCursor -> m Cursor
SDLE.createSystemCursor (CursorIcon -> SystemCursor
cursorToSDL CursorIcon
icon)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CursorIcon
icon Cursor
cursor Map CursorIcon Cursor
map

-- | Initializes a widget (in general, this is called for root).
handleWidgetInit
  :: MonomerM s e m
  => WidgetEnv s e
  -> WidgetNode s e
  -> m (HandlerStep s e)
handleWidgetInit :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e -> WidgetNode s e -> m (HandlerStep s e)
handleWidgetInit WidgetEnv s e
wenv WidgetNode s e
widgetRoot = do
  let widget :: Widget s e
widget = WidgetNode s e
widgetRoot forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  let widgetResult :: WidgetResult s e
widgetResult = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
widgetRoot
  let reqs :: Seq (WidgetRequest s e)
reqs = WidgetResult s e
widgetResult forall s a. s -> Getting a s a -> a
^. forall s a. HasRequests s a => Lens' s a
L.requests
  let focusReqExists :: Bool
focusReqExists = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL forall s e. WidgetRequest s e -> Bool
isFocusRequest Seq (WidgetRequest s e)
reqs

  forall s a. HasResizeRequests s a => Lens' s a
L.resizeRequests forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Seq a
Seq.singleton forall a. Default a => a
def

  HandlerStep s e
step <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e -> Bool -> WidgetResult s e -> m (HandlerStep s e)
handleWidgetResult WidgetEnv s e
wenv Bool
True WidgetResult s e
widgetResult
  Path
currFocus <- forall s e (m :: * -> *). MonomerM s e m => m Path
getFocusedPath

  if Bool -> Bool
not Bool
focusReqExists Bool -> Bool -> Bool
&& Path
currFocus forall a. Eq a => a -> a -> Bool
== Path
emptyPath
    then forall s e (m :: * -> *).
MonomerM s e m =>
Maybe WidgetId
-> FocusDirection -> HandlerStep s e -> m (HandlerStep s e)
handleMoveFocus forall a. Maybe a
Nothing FocusDirection
FocusFwd HandlerStep s e
step
    else forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step

-- | Disposes a widget (in general, this is called for root).
handleWidgetDispose
  :: MonomerM s e m
  => WidgetEnv s e
  -> WidgetNode s e
  -> m (HandlerStep s e)
handleWidgetDispose :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e -> WidgetNode s e -> m (HandlerStep s e)
handleWidgetDispose WidgetEnv s e
wenv WidgetNode s e
widgetRoot = do
  let widget :: Widget s e
widget = WidgetNode s e
widgetRoot forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  let widgetResult :: WidgetResult s e
widgetResult = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetDispose Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
widgetRoot

  forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e -> Bool -> WidgetResult s e -> m (HandlerStep s e)
handleWidgetResult WidgetEnv s e
wenv Bool
False WidgetResult s e
widgetResult

{-|
Handles a WidgetResult instance, processing events and requests, and returning
an updated "HandlerStep".
-}
handleWidgetResult
  :: MonomerM s e m
  => WidgetEnv s e
  -> Bool
  -> WidgetResult s e
  -> m (HandlerStep s e)
handleWidgetResult :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e -> Bool -> WidgetResult s e -> m (HandlerStep s e)
handleWidgetResult WidgetEnv s e
wenv Bool
resizeWidgets WidgetResult s e
result = do
  let WidgetResult WidgetNode s e
evtRoot Seq (WidgetRequest s e)
reqs = WidgetResult s e
result

  HandlerStep s e
step <- forall s e (m :: * -> *).
MonomerM s e m =>
Seq (WidgetRequest s e) -> HandlerStep s e -> m (HandlerStep s e)
handleRequests Seq (WidgetRequest s e)
reqs (WidgetEnv s e
wenv, WidgetNode s e
evtRoot, Seq (WidgetRequest s e)
reqs)
  Seq WidgetId
resizeRequests <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasResizeRequests s a => Lens' s a
L.resizeRequests

  if Bool
resizeWidgets Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq WidgetId
resizeRequests)
    then forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleResizeWidgets HandlerStep s e
step
    else forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step

-- | Processes a Seq of WidgetRequest, returning the latest "HandlerStep".
handleRequests
  :: MonomerM s e m
  => Seq (WidgetRequest s e)  -- ^ Requests to process.
  -> HandlerStep s e          -- ^ Initial state/"HandlerStep".
  -> m (HandlerStep s e)      -- ^ Updated "HandlerStep",
handleRequests :: forall s e (m :: * -> *).
MonomerM s e m =>
Seq (WidgetRequest s e) -> HandlerStep s e -> m (HandlerStep s e)
handleRequests Seq (WidgetRequest s e)
reqs HandlerStep s e
step = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *} {s} {e} {e}.
(Eq s, MonadState (MonomerCtx s e) m, MonadCatch m, MonadIO m) =>
HandlerStep s e -> WidgetRequest s e -> m (HandlerStep s e)
handleRequest HandlerStep s e
step Seq (WidgetRequest s e)
reqs where
  handleRequest :: HandlerStep s e -> WidgetRequest s e -> m (HandlerStep s e)
handleRequest HandlerStep s e
step WidgetRequest s e
req = case WidgetRequest s e
req of
    WidgetRequest s e
IgnoreParentEvents -> forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step
    WidgetRequest s e
IgnoreChildrenEvents -> forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step
    ResizeWidgets WidgetId
wid -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleAddPendingResize WidgetId
wid HandlerStep s e
step
    ResizeWidgetsImmediate WidgetId
wid -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResizeImmediate WidgetId
wid HandlerStep s e
step
    MoveFocus Maybe WidgetId
start FocusDirection
dir -> forall s e (m :: * -> *).
MonomerM s e m =>
Maybe WidgetId
-> FocusDirection -> HandlerStep s e -> m (HandlerStep s e)
handleMoveFocus Maybe WidgetId
start FocusDirection
dir HandlerStep s e
step
    SetFocus WidgetId
path -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleSetFocus WidgetId
path HandlerStep s e
step
    GetClipboard WidgetId
wid -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleGetClipboard WidgetId
wid HandlerStep s e
step
    SetClipboard ClipboardData
cdata -> forall s e (m :: * -> *).
MonomerM s e m =>
ClipboardData -> HandlerStep s e -> m (HandlerStep s e)
handleSetClipboard ClipboardData
cdata HandlerStep s e
step
    StartTextInput Rect
rect -> forall s e (m :: * -> *).
MonomerM s e m =>
Rect -> HandlerStep s e -> m (HandlerStep s e)
handleStartTextInput Rect
rect HandlerStep s e
step
    WidgetRequest s e
StopTextInput -> forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleStopTextInput HandlerStep s e
step
    SetOverlay WidgetId
wid Path
path -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> HandlerStep s e -> m (HandlerStep s e)
handleSetOverlay WidgetId
wid Path
path HandlerStep s e
step
    ResetOverlay WidgetId
wid -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetOverlay WidgetId
wid HandlerStep s e
step
    SetCursorIcon WidgetId
wid CursorIcon
icon -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> CursorIcon -> HandlerStep s e -> m (HandlerStep s e)
handleSetCursorIcon WidgetId
wid CursorIcon
icon HandlerStep s e
step
    ResetCursorIcon WidgetId
wid -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetCursorIcon WidgetId
wid HandlerStep s e
step
    StartDrag WidgetId
wid Path
path WidgetDragMsg
info -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId
-> Path -> WidgetDragMsg -> HandlerStep s e -> m (HandlerStep s e)
handleStartDrag WidgetId
wid Path
path WidgetDragMsg
info HandlerStep s e
step
    StopDrag WidgetId
wid -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleStopDrag WidgetId
wid HandlerStep s e
step
    WidgetRequest s e
RenderOnce -> forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleRenderOnce HandlerStep s e
step
    RenderEvery WidgetId
wid Millisecond
ms Maybe Int
repeat -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId
-> Millisecond
-> Maybe Int
-> HandlerStep s e
-> m (HandlerStep s e)
handleRenderEvery WidgetId
wid Millisecond
ms Maybe Int
repeat HandlerStep s e
step
    RenderStop WidgetId
wid -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleRenderStop WidgetId
wid HandlerStep s e
step
    RemoveRendererImage Text
path -> forall s e (m :: * -> *).
MonomerM s e m =>
Text -> HandlerStep s e -> m (HandlerStep s e)
handleRemoveRendererImage Text
path HandlerStep s e
step
    ExitApplication Bool
exit -> forall s e (m :: * -> *).
MonomerM s e m =>
Bool -> HandlerStep s e -> m (HandlerStep s e)
handleExitApplication Bool
exit HandlerStep s e
step
    UpdateWindow WindowRequest
req -> forall s e (m :: * -> *).
MonomerM s e m =>
WindowRequest -> HandlerStep s e -> m (HandlerStep s e)
handleUpdateWindow WindowRequest
req HandlerStep s e
step
    UpdateModel s -> s
fn -> forall s e (m :: * -> *).
MonomerM s e m =>
(s -> s) -> HandlerStep s e -> m (HandlerStep s e)
handleUpdateModel s -> s
fn HandlerStep s e
step
    SetWidgetPath WidgetId
wid Path
path -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> HandlerStep s e -> m (HandlerStep s e)
handleSetWidgetPath WidgetId
wid Path
path HandlerStep s e
step
    ResetWidgetPath WidgetId
wid -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetWidgetPath WidgetId
wid HandlerStep s e
step
    RaiseEvent e
msg -> forall s e (m :: * -> *) msg.
(MonomerM s e m, Typeable msg) =>
msg -> HandlerStep s e -> m (HandlerStep s e)
handleRaiseEvent e
msg HandlerStep s e
step
    SendMessage WidgetId
wid i
msg -> forall s e (m :: * -> *) msg.
(MonomerM s e m, Typeable msg) =>
WidgetId -> msg -> HandlerStep s e -> m (HandlerStep s e)
handleSendMessage WidgetId
wid i
msg HandlerStep s e
step
    RunTask WidgetId
wid Path
path IO i
handler -> forall s e (m :: * -> *) i.
(MonomerM s e m, Typeable i) =>
WidgetId -> Path -> IO i -> HandlerStep s e -> m (HandlerStep s e)
handleRunTask WidgetId
wid Path
path IO i
handler HandlerStep s e
step
    RunProducer WidgetId
wid Path
path (i -> IO ()) -> IO ()
handler -> forall s e (m :: * -> *) i.
(MonomerM s e m, Typeable i) =>
WidgetId
-> Path
-> ((i -> IO ()) -> IO ())
-> HandlerStep s e
-> m (HandlerStep s e)
handleRunProducer WidgetId
wid Path
path (i -> IO ()) -> IO ()
handler HandlerStep s e
step
    RunInRenderThread WidgetId
wid Path
path IO i
handler -> forall s e (m :: * -> *) i.
(MonomerM s e m, Typeable i) =>
WidgetId -> Path -> IO i -> HandlerStep s e -> m (HandlerStep s e)
handleRunInRenderThread WidgetId
wid Path
path IO i
handler HandlerStep s e
step

-- | Resizes the current root, and marks the render and resized flags.
handleResizeWidgets
  :: MonomerM s e m
  => HandlerStep s e      -- ^ Current state/"HandlerStep".
  -> m (HandlerStep s e)  -- ^ Updated state/"HandlerStep".
handleResizeWidgets :: forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleResizeWidgets HandlerStep s e
previousStep = do
  Size
windowSize <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasWindowSize s a => Lens' s a
L.windowSize
  Path -> Bool
resizeCheckFn <- m (Path -> Bool)
makeResizeCheckFn

  let viewport :: Rect
viewport = Double -> Double -> Double -> Double -> Rect
Rect Double
0 Double
0 (Size
windowSize forall s a. s -> Getting a s a -> a
^. forall s a. HasW s a => Lens' s a
L.w) (Size
windowSize forall s a. s -> Getting a s a -> a
^. forall s a. HasH s a => Lens' s a
L.h)
  let (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs) = HandlerStep s e
previousStep
  let newWenv :: WidgetEnv s e
newWenv = WidgetEnv s e
wenv
        forall a b. a -> (a -> b) -> b
& forall s a. HasWindowSize s a => Lens' s a
L.windowSize forall s t a b. ASetter s t a b -> b -> s -> t
.~ Size
windowSize
        forall a b. a -> (a -> b) -> b
& forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
viewport
  let rootWidget :: Widget s e
rootWidget = WidgetNode s e
root forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  let newResult :: WidgetResult s e
newResult = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize Widget s e
rootWidget WidgetEnv s e
newWenv WidgetNode s e
root Rect
viewport Path -> Bool
resizeCheckFn

  forall s a. HasRenderRequested s a => Lens' s a
L.renderRequested forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
  forall s a. HasResizeRequests s a => Lens' s a
L.resizeRequests forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Seq a
Seq.empty

  (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs2) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e -> Bool -> WidgetResult s e -> m (HandlerStep s e)
handleWidgetResult WidgetEnv s e
newWenv Bool
True WidgetResult s e
newResult

  forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs2)
  where
    makeResizeCheckFn :: m (Path -> Bool)
makeResizeCheckFn = do
      Seq WidgetId
resizeRequests <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasResizeRequests s a => Lens' s a
L.resizeRequests
      Seq Path
paths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath Seq WidgetId
resizeRequests
      let parts :: Seq a -> Set (Seq a)
parts = forall a. [a] -> Set a
Set.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq (Seq a)
Seq.inits
      let sets :: Set Path
sets = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a}. Seq a -> Set (Seq a)
parts Seq Path
paths

      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Path
sets)

handleAddPendingResize
  :: MonomerM s e m
  => WidgetId
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleAddPendingResize :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleAddPendingResize WidgetId
wid HandlerStep s e
step = do
  forall s a. HasResizeRequests s a => Lens' s a
L.resizeRequests forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Seq a -> a -> Seq a
|> WidgetId
wid)
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step

handleResizeImmediate
  :: MonomerM s e m
  => WidgetId
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleResizeImmediate :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResizeImmediate WidgetId
wid HandlerStep s e
step = do
  forall s a. HasResizeRequests s a => Lens' s a
L.resizeRequests forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Seq a -> a -> Seq a
|> WidgetId
wid)
  forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleResizeWidgets HandlerStep s e
step

handleMoveFocus
  :: MonomerM s e m
  => Maybe WidgetId
  -> FocusDirection
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleMoveFocus :: forall s e (m :: * -> *).
MonomerM s e m =>
Maybe WidgetId
-> FocusDirection -> HandlerStep s e -> m (HandlerStep s e)
handleMoveFocus Maybe WidgetId
startFromWid FocusDirection
dir (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs) = do
  Path
oldFocus <- forall s e (m :: * -> *). MonomerM s e m => m Path
getFocusedPath
  Maybe Path
tmpOverlay <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getOverlayPath
  let tmpFocusWni :: WidgetNodeInfo
tmpFocusWni = forall s e.
WidgetEnv s e
-> FocusDirection
-> Path
-> Maybe Path
-> WidgetNode s e
-> WidgetNodeInfo
findNextFocus WidgetEnv s e
wenv FocusDirection
dir Path
oldFocus Maybe Path
tmpOverlay WidgetNode s e
root
  let tmpFocus :: Path
tmpFocus = WidgetNodeInfo
tmpFocusWni forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path
  let blurEvt :: SystemEvent
blurEvt = Path -> SystemEvent
Blur Path
tmpFocus
  let wenv0 :: WidgetEnv s e
wenv0 = WidgetEnv s e
wenv forall a b. a -> (a -> b) -> b
& forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath forall s t a b. ASetter s t a b -> b -> s -> t
.~ Path
tmpFocus
  (WidgetEnv s e
wenv1, WidgetNode s e
root1, Seq (WidgetRequest s e)
reqs1) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> SystemEvent -> Path -> m (HandlerStep s e)
handleSystemEvent WidgetEnv s e
wenv0 WidgetNode s e
root SystemEvent
blurEvt Path
oldFocus
  Path
currFocus <- forall s e (m :: * -> *). MonomerM s e m => m Path
getFocusedPath
  Maybe Path
currOverlay <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getOverlayPath

  if Path
oldFocus forall a. Eq a => a -> a -> Bool
== Path
currFocus
    then do
      Maybe Path
startFrom <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath Maybe WidgetId
startFromWid
      let searchFrom :: Path
searchFrom = forall a. a -> Maybe a -> a
fromMaybe Path
currFocus Maybe Path
startFrom
      let newFocusWni :: WidgetNodeInfo
newFocusWni = forall s e.
WidgetEnv s e
-> FocusDirection
-> Path
-> Maybe Path
-> WidgetNode s e
-> WidgetNodeInfo
findNextFocus WidgetEnv s e
wenv1 FocusDirection
dir Path
searchFrom Maybe Path
currOverlay WidgetNode s e
root1
      let newFocus :: Path
newFocus = WidgetNodeInfo
newFocusWni forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path
      let wenvF :: WidgetEnv s e
wenvF = WidgetEnv s e
wenv1 forall a b. a -> (a -> b) -> b
& forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath forall s t a b. ASetter s t a b -> b -> s -> t
.~ Path
newFocus
      let focusEvt :: SystemEvent
focusEvt = Path -> SystemEvent
Focus Path
oldFocus

      forall s a. HasFocusedWidgetId s a => Lens' s a
L.focusedWidgetId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= WidgetNodeInfo
newFocusWni forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      forall s a. HasRenderRequested s a => Lens' s a
L.renderRequested forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs2) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> SystemEvent -> Path -> m (HandlerStep s e)
handleSystemEvent WidgetEnv s e
wenvF WidgetNode s e
root1 SystemEvent
focusEvt Path
newFocus

      forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs1 forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs2)
    else
      forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv1, WidgetNode s e
root1, Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs1)

handleSetFocus
  :: MonomerM s e m => WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleSetFocus :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleSetFocus WidgetId
newFocusWid (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs) = do
  Path
newFocus <- forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
newFocusWid
  Path
oldFocus <- forall s e (m :: * -> *). MonomerM s e m => m Path
getFocusedPath

  if Path
oldFocus forall a. Eq a => a -> a -> Bool
/= Path
newFocus Bool -> Bool -> Bool
&& Path
newFocus forall a. Eq a => a -> a -> Bool
/= Path
emptyPath
    then do
      let wenv0 :: WidgetEnv s e
wenv0 = WidgetEnv s e
wenv forall a b. a -> (a -> b) -> b
& forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath forall s t a b. ASetter s t a b -> b -> s -> t
.~ Path
newFocus
      let blurEvt :: SystemEvent
blurEvt = Path -> SystemEvent
Blur Path
newFocus
      (WidgetEnv s e
wenv1, WidgetNode s e
root1, Seq (WidgetRequest s e)
reqs1) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> SystemEvent -> Path -> m (HandlerStep s e)
handleSystemEvent WidgetEnv s e
wenv0 WidgetNode s e
root SystemEvent
blurEvt Path
oldFocus
      let wenvF :: WidgetEnv s e
wenvF = WidgetEnv s e
wenv1 forall a b. a -> (a -> b) -> b
& forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath forall s t a b. ASetter s t a b -> b -> s -> t
.~ Path
newFocus
      let focusEvt :: SystemEvent
focusEvt = Path -> SystemEvent
Focus Path
oldFocus

      forall s a. HasFocusedWidgetId s a => Lens' s a
L.focusedWidgetId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= WidgetId
newFocusWid
      forall s a. HasRenderRequested s a => Lens' s a
L.renderRequested forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs2) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> SystemEvent -> Path -> m (HandlerStep s e)
handleSystemEvent WidgetEnv s e
wenvF WidgetNode s e
root1 SystemEvent
focusEvt Path
newFocus

      forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs1 forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs2)
    else
      forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs)

handleGetClipboard
  :: MonomerM s e m => WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleGetClipboard :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleGetClipboard WidgetId
widgetId (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs) = do
  Path
path <- forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
widgetId
  Bool
hasText <- forall (m :: * -> *). MonadIO m => m Bool
SDL.hasClipboardText
  SystemEvent
contents <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClipboardData -> SystemEvent
Clipboard forall a b. (a -> b) -> a -> b
$ if Bool
hasText
                then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ClipboardData
ClipboardText forall (m :: * -> *). MonadIO m => m Text
SDL.getClipboardText
                else forall (m :: * -> *) a. Monad m => a -> m a
return ClipboardData
ClipboardEmpty

  (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs2) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> SystemEvent -> Path -> m (HandlerStep s e)
handleSystemEvent WidgetEnv s e
wenv WidgetNode s e
root SystemEvent
contents Path
path
  forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs2)

handleSetClipboard
  :: MonomerM s e m => ClipboardData -> HandlerStep s e -> m (HandlerStep s e)
handleSetClipboard :: forall s e (m :: * -> *).
MonomerM s e m =>
ClipboardData -> HandlerStep s e -> m (HandlerStep s e)
handleSetClipboard (ClipboardText Text
text) HandlerStep s e
previousStep = do
  forall (m :: * -> *). MonadIO m => Text -> m ()
SDL.setClipboardText Text
text
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep
handleSetClipboard ClipboardData
_ HandlerStep s e
previousStep = forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleStartTextInput
  :: MonomerM s e m => Rect -> HandlerStep s e -> m (HandlerStep s e)
handleStartTextInput :: forall s e (m :: * -> *).
MonomerM s e m =>
Rect -> HandlerStep s e -> m (HandlerStep s e)
handleStartTextInput (Rect Double
x Double
y Double
w Double
h) HandlerStep s e
previousStep = do
  forall (m :: * -> *). MonadIO m => Rect -> m ()
SDL.startTextInput (CInt -> CInt -> CInt -> CInt -> Rect
SDLT.Rect (forall {a} {b}. (RealFrac a, Num b) => a -> b
c Double
x) (forall {a} {b}. (RealFrac a, Num b) => a -> b
c Double
y) (forall {a} {b}. (RealFrac a, Num b) => a -> b
c Double
w) (forall {a} {b}. (RealFrac a, Num b) => a -> b
c Double
h))
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep
  where
    c :: a -> b
c a
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round a
x

handleStopTextInput :: MonomerM s e m => HandlerStep s e -> m (HandlerStep s e)
handleStopTextInput :: forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleStopTextInput HandlerStep s e
previousStep = do
  forall (m :: * -> *). MonadIO m => m ()
SDL.stopTextInput
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleSetOverlay
  :: MonomerM s e m
  => WidgetId
  -> Path
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleSetOverlay :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> HandlerStep s e -> m (HandlerStep s e)
handleSetOverlay WidgetId
widgetId Path
path HandlerStep s e
previousStep = do
  Maybe WidgetId
overlay <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasOverlayWidgetId s a => Lens' s a
L.overlayWidgetId

  forall s a. HasOverlayWidgetId s a => Lens' s a
L.overlayWidgetId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just WidgetId
widgetId
  forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> m ()
setWidgetIdPath WidgetId
widgetId Path
path
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HandlerStep s e
previousStep
    forall a b. a -> (a -> b) -> b
& forall s t a b. Field1 s t a b => Lens s t a b
_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Path
path

handleResetOverlay
  :: MonomerM s e m => WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetOverlay :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetOverlay WidgetId
widgetId HandlerStep s e
step = do
  let (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs) = HandlerStep s e
step
  let mousePos :: Point
mousePos = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos

  Maybe WidgetId
overlay <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasOverlayWidgetId s a => Lens' s a
L.overlayWidgetId

  (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs2) <- if Maybe WidgetId
overlay forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just WidgetId
widgetId
    then do
      let newWenv :: WidgetEnv s e
newWenv = WidgetEnv s e
wenv forall a b. a -> (a -> b) -> b
& forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
      forall s a. HasOverlayWidgetId s a => Lens' s a
L.overlayWidgetId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetCursorIcon WidgetId
widgetId HandlerStep s e
step
      forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e -> [SystemEvent] -> m (HandlerStep s e)
handleSystemEvents WidgetEnv s e
newWenv WidgetNode s e
root [Point -> SystemEvent
Move Point
mousePos]
    else
      forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv, WidgetNode s e
root, forall a. Seq a
Empty)

  forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv2, WidgetNode s e
root2, Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
reqs2)

handleSetCursorIcon
  :: MonomerM s e m
  => WidgetId
  -> CursorIcon
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleSetCursorIcon :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> CursorIcon -> HandlerStep s e -> m (HandlerStep s e)
handleSetCursorIcon WidgetId
wid CursorIcon
icon HandlerStep s e
previousStep = do
  [(WidgetId, CursorIcon)]
cursors <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasCursorStack s a => Lens' s a
L.cursorStack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s e (m :: * -> *) a.
MonomerM s e m =>
WidgetId -> [(WidgetId, a)] -> m [(WidgetId, a)]
dropNonParentWidgetId WidgetId
wid
  forall s a. HasCursorStack s a => Lens' s a
L.cursorStack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (WidgetId
wid, CursorIcon
icon) forall a. a -> [a] -> [a]
: [(WidgetId, CursorIcon)]
cursors
  Maybe Cursor
cursor <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CursorIcon
icon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasCursorIcons s a => Lens' s a
L.cursorIcons

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe Cursor
cursor) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLnErr forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid handleSetCursorIcon: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CursorIcon
icon

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Cursor
cursor forall (m :: * -> *). MonadIO m => Cursor -> m ()
SDLE.setCursor

  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleResetCursorIcon
  :: MonomerM s e m
  => WidgetId
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleResetCursorIcon :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetCursorIcon WidgetId
wid HandlerStep s e
previousStep = do
  [(WidgetId, CursorIcon)]
cursors <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasCursorStack s a => Lens' s a
L.cursorStack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s e (m :: * -> *) a.
MonomerM s e m =>
WidgetId -> [(WidgetId, a)] -> m [(WidgetId, a)]
dropNonParentWidgetId WidgetId
wid
  let newCursors :: [(WidgetId, CursorIcon)]
newCursors = forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Eq a => a -> a -> Bool
==WidgetId
wid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(WidgetId, CursorIcon)]
cursors
  let newCursorIcon :: CursorIcon
newCursorIcon
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(WidgetId, CursorIcon)]
newCursors = CursorIcon
CursorArrow
        | Bool
otherwise = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [(WidgetId, CursorIcon)]
newCursors
  forall s a. HasCursorStack s a => Lens' s a
L.cursorStack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(WidgetId, CursorIcon)]
newCursors
  Cursor
cursor <- (forall k a. Ord k => Map k a -> k -> a
Map.! CursorIcon
newCursorIcon) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasCursorIcons s a => Lens' s a
L.cursorIcons
  forall (m :: * -> *). MonadIO m => Cursor -> m ()
SDLE.setCursor Cursor
cursor

  Maybe (Path, CursorIcon)
currentPair <- forall a. [a] -> Maybe a
headMay [(WidgetId, CursorIcon)]
newCursors forall a b. a -> (a -> b) -> b
& forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1 forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HandlerStep s e
previousStep
    forall a b. a -> (a -> b) -> b
& forall s t a b. Field1 s t a b => Lens s t a b
_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCursor s a => Lens' s a
L.cursor forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Path, CursorIcon)
currentPair

handleStartDrag
  :: MonomerM s e m
  => WidgetId
  -> Path
  -> WidgetDragMsg
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleStartDrag :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId
-> Path -> WidgetDragMsg -> HandlerStep s e -> m (HandlerStep s e)
handleStartDrag WidgetId
widgetId Path
path WidgetDragMsg
dragData HandlerStep s e
previousStep = do
  Maybe DragAction
oldDragAction <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasDragAction s a => Lens' s a
L.dragAction
  let prevWidgetId :: Maybe WidgetId
prevWidgetId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId) Maybe DragAction
oldDragAction

  forall s a. HasDragAction s a => Lens' s a
L.dragAction forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (WidgetId -> WidgetDragMsg -> DragAction
DragAction WidgetId
widgetId WidgetDragMsg
dragData)
  forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> m ()
setWidgetIdPath WidgetId
widgetId Path
path
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HandlerStep s e
previousStep
    forall a b. a -> (a -> b) -> b
& forall s t a b. Field1 s t a b => Lens s t a b
_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDragStatus s a => Lens' s a
L.dragStatus forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Path
path, WidgetDragMsg
dragData)

handleStopDrag
  :: MonomerM s e m
  => WidgetId
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleStopDrag :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleStopDrag WidgetId
widgetId HandlerStep s e
previousStep = do
  Maybe DragAction
oldDragAction <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasDragAction s a => Lens' s a
L.dragAction
  let prevWidgetId :: Maybe WidgetId
prevWidgetId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId) Maybe DragAction
oldDragAction

  if Maybe WidgetId
prevWidgetId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just WidgetId
widgetId
    then do
      forall s a. HasRenderRequested s a => Lens' s a
L.renderRequested forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      forall s a. HasDragAction s a => Lens' s a
L.dragAction forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HandlerStep s e
previousStep
        forall a b. a -> (a -> b) -> b
& forall s t a b. Field1 s t a b => Lens s t a b
_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDragStatus s a => Lens' s a
L.dragStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
  else forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleFinalizeDrop
  :: MonomerM s e m
  => HandlerStep s e
  -> m (HandlerStep s e)
handleFinalizeDrop :: forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleFinalizeDrop HandlerStep s e
previousStep = do
  Maybe DragAction
dragAction <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasDragAction s a => Lens' s a
L.dragAction
  let widgetId :: Maybe WidgetId
widgetId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId) Maybe DragAction
dragAction

  if forall a. Maybe a -> Bool
isJust Maybe WidgetId
widgetId
    then do
      forall s a. HasRenderRequested s a => Lens' s a
L.renderRequested forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      forall s a. HasDragAction s a => Lens' s a
L.dragAction forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HandlerStep s e
previousStep
        forall a b. a -> (a -> b) -> b
& forall s t a b. Field1 s t a b => Lens s t a b
_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDragStatus s a => Lens' s a
L.dragStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
    else forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleRenderOnce :: MonomerM s e m => HandlerStep s e -> m (HandlerStep s e)
handleRenderOnce :: forall s e (m :: * -> *).
MonomerM s e m =>
HandlerStep s e -> m (HandlerStep s e)
handleRenderOnce HandlerStep s e
previousStep = do
  forall s a. HasRenderRequested s a => Lens' s a
L.renderRequested forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleRenderEvery
  :: MonomerM s e m
  => WidgetId
  -> Millisecond
  -> Maybe Int
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleRenderEvery :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId
-> Millisecond
-> Maybe Int
-> HandlerStep s e
-> m (HandlerStep s e)
handleRenderEvery WidgetId
widgetId Millisecond
ms Maybe Int
repeat HandlerStep s e
previousStep = do
  Map WidgetId RenderSchedule
schedule <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasRenderSchedule s a => Lens' s a
L.renderSchedule
  forall s a. HasRenderSchedule s a => Lens' s a
L.renderSchedule forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map WidgetId RenderSchedule -> Map WidgetId RenderSchedule
addSchedule Map WidgetId RenderSchedule
schedule
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep
  where
    (WidgetEnv s e
wenv, WidgetNode s e
_, Seq (WidgetRequest s e)
_) = HandlerStep s e
previousStep
    newValue :: RenderSchedule
newValue = RenderSchedule {
      _rsWidgetId :: WidgetId
_rsWidgetId = WidgetId
widgetId,
      _rsStart :: Millisecond
_rsStart = forall s e. WidgetEnv s e -> Millisecond
_weTimestamp WidgetEnv s e
wenv,
      _rsMs :: Millisecond
_rsMs = Millisecond
ms,
      _rsRepeat :: Maybe Int
_rsRepeat = Maybe Int
repeat
    }
    addSchedule :: Map WidgetId RenderSchedule -> Map WidgetId RenderSchedule
addSchedule Map WidgetId RenderSchedule
schedule
      | Millisecond
ms forall a. Ord a => a -> a -> Bool
> Millisecond
0 = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert WidgetId
widgetId RenderSchedule
newValue Map WidgetId RenderSchedule
schedule
      | Bool
otherwise = Map WidgetId RenderSchedule
schedule

handleRenderStop
  :: MonomerM s e m => WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleRenderStop :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleRenderStop WidgetId
widgetId HandlerStep s e
previousStep = do
  Map WidgetId RenderSchedule
schedule <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasRenderSchedule s a => Lens' s a
L.renderSchedule
  forall s a. HasRenderSchedule s a => Lens' s a
L.renderSchedule forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall k a. Ord k => k -> Map k a -> Map k a
Map.delete WidgetId
widgetId Map WidgetId RenderSchedule
schedule
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleRemoveRendererImage
  :: MonomerM s e m => Text -> HandlerStep s e -> m (HandlerStep s e)
handleRemoveRendererImage :: forall s e (m :: * -> *).
MonomerM s e m =>
Text -> HandlerStep s e -> m (HandlerStep s e)
handleRemoveRendererImage Text
name HandlerStep s e
previousStep = do
  Either Renderer (TChan (RenderMsg s e))
renderMethod <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasRenderMethod s a => Lens' s a
L.renderMethod

  case Either Renderer (TChan (RenderMsg s e))
renderMethod of
    Left Renderer
renderer -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Renderer -> Text -> IO ()
deleteImage Renderer
renderer Text
name
    Right TChan (RenderMsg s e)
chan -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> a -> STM ()
writeTChan TChan (RenderMsg s e)
chan (forall s e. Text -> RenderMsg s e
MsgRemoveImage Text
name)

  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleExitApplication
  :: MonomerM s e m => Bool -> HandlerStep s e -> m (HandlerStep s e)
handleExitApplication :: forall s e (m :: * -> *).
MonomerM s e m =>
Bool -> HandlerStep s e -> m (HandlerStep s e)
handleExitApplication Bool
exit HandlerStep s e
previousStep = do
  forall s a. HasExitApplication s a => Lens' s a
L.exitApplication forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
exit
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleUpdateWindow
  :: MonomerM s e m => WindowRequest -> HandlerStep s e -> m (HandlerStep s e)
handleUpdateWindow :: forall s e (m :: * -> *).
MonomerM s e m =>
WindowRequest -> HandlerStep s e -> m (HandlerStep s e)
handleUpdateWindow WindowRequest
windowRequest HandlerStep s e
previousStep = do
  Window
window <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasWindow s a => Lens' s a
L.window
  case WindowRequest
windowRequest of
    WindowSetTitle Text
title -> Window -> StateVar Text
SDL.windowTitle Window
window forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Text
title
    WindowRequest
WindowSetFullScreen -> forall (m :: * -> *). MonadIO m => Window -> WindowMode -> m ()
SDL.setWindowMode Window
window WindowMode
SDL.FullscreenDesktop
    WindowRequest
WindowMaximize -> forall (m :: * -> *). MonadIO m => Window -> WindowMode -> m ()
SDL.setWindowMode Window
window WindowMode
SDL.Maximized
    WindowRequest
WindowMinimize -> forall (m :: * -> *). MonadIO m => Window -> WindowMode -> m ()
SDL.setWindowMode Window
window WindowMode
SDL.Minimized
    WindowRequest
WindowRestore -> forall (m :: * -> *). MonadIO m => Window -> WindowMode -> m ()
SDL.setWindowMode Window
window WindowMode
SDL.Windowed
    WindowRequest
WindowBringToFront -> forall (m :: * -> *). MonadIO m => Window -> m ()
SDL.raiseWindow Window
window
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleUpdateModel
  :: MonomerM s e m => (s -> s) -> HandlerStep s e -> m (HandlerStep s e)
handleUpdateModel :: forall s e (m :: * -> *).
MonomerM s e m =>
(s -> s) -> HandlerStep s e -> m (HandlerStep s e)
handleUpdateModel s -> s
fn (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs) = do
  forall s a. HasMainModel s a => Lens' s a
L.mainModel forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv2
  forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
wenv2, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs)
  where
    wenv2 :: WidgetEnv s e
wenv2 = WidgetEnv s e
wenv forall a b. a -> (a -> b) -> b
& forall s a. HasModel s a => Lens' s a
L.model forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ s -> s
fn

handleSetWidgetPath
  :: MonomerM s e m => WidgetId -> Path -> HandlerStep s e -> m (HandlerStep s e)
handleSetWidgetPath :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> HandlerStep s e -> m (HandlerStep s e)
handleSetWidgetPath WidgetId
wid Path
path HandlerStep s e
step = do
  forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> m ()
setWidgetIdPath WidgetId
wid Path
path
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step

handleResetWidgetPath
  :: MonomerM s e m => WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetWidgetPath :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetWidgetPath WidgetId
wid HandlerStep s e
step = do
  forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m ()
delWidgetIdPath WidgetId
wid
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step

handleRaiseEvent
  :: forall s e m msg . (MonomerM s e m, Typeable msg)
  => msg
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleRaiseEvent :: forall s e (m :: * -> *) msg.
(MonomerM s e m, Typeable msg) =>
msg -> HandlerStep s e -> m (HandlerStep s e)
handleRaiseEvent msg
message HandlerStep s e
step = do
  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
step
  where
    message :: [Char]
message = [Char]
"Invalid state. RaiseEvent reached main handler. Type: "

handleSendMessage
  :: forall s e m msg . (MonomerM s e m, Typeable msg)
  => WidgetId
  -> msg
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleSendMessage :: forall s e (m :: * -> *) msg.
(MonomerM s e m, Typeable msg) =>
WidgetId -> msg -> HandlerStep s e -> m (HandlerStep s e)
handleSendMessage WidgetId
widgetId msg
message (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
reqs) = do
  Path
path <- forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
widgetId

  let emptyResult :: WidgetResult s e
emptyResult = forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
root forall a. Seq a
Seq.empty
  let widget :: Widget s e
widget = WidgetNode s e
root forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  let msgResult :: Maybe (WidgetResult s e)
msgResult = forall s e.
Widget s e
-> forall i.
   Typeable i =>
   WidgetEnv s e
   -> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
widgetHandleMessage Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
root Path
path msg
message
  let result :: WidgetResult s e
result = forall a. a -> Maybe a -> a
fromMaybe WidgetResult s e
emptyResult Maybe (WidgetResult s e)
msgResult

  (WidgetEnv s e
newWenv, WidgetNode s e
newRoot, Seq (WidgetRequest s e)
newReqs) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e -> Bool -> WidgetResult s e -> m (HandlerStep s e)
handleWidgetResult WidgetEnv s e
wenv Bool
True WidgetResult s e
result

  forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetEnv s e
newWenv, WidgetNode s e
newRoot, Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
newReqs)

handleRunTask
  :: forall s e m i . (MonomerM s e m, Typeable i)
  => WidgetId
  -> Path
  -> IO i
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleRunTask :: forall s e (m :: * -> *) i.
(MonomerM s e m, Typeable i) =>
WidgetId -> Path -> IO i -> HandlerStep s e -> m (HandlerStep s e)
handleRunTask WidgetId
widgetId Path
path IO i
handler HandlerStep s e
previousStep = do
  Async i
asyncTask <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO i
handler)

  Seq WidgetTask
previousTasks <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasWidgetTasks s a => Lens' s a
L.widgetTasks
  forall s a. HasWidgetTasks s a => Lens' s a
L.widgetTasks forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Seq WidgetTask
previousTasks forall a. Seq a -> a -> Seq a
|> forall i. Typeable i => WidgetId -> Async i -> WidgetTask
WidgetTask WidgetId
widgetId Async i
asyncTask
  forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> m ()
setWidgetIdPath WidgetId
widgetId Path
path

  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleRunProducer
  :: forall s e m i . (MonomerM s e m, Typeable i)
  => WidgetId
  -> Path
  -> ((i -> IO ()) -> IO ())
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleRunProducer :: forall s e (m :: * -> *) i.
(MonomerM s e m, Typeable i) =>
WidgetId
-> Path
-> ((i -> IO ()) -> IO ())
-> HandlerStep s e
-> m (HandlerStep s e)
handleRunProducer WidgetId
widgetId Path
path (i -> IO ()) -> IO ()
handler HandlerStep s e
previousStep = do
  TChan i
newChannel <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (TChan a)
newTChanIO
  Async ()
asyncTask <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (i -> IO ()) -> IO ()
handler (forall e. TChan e -> e -> IO ()
sendMessage TChan i
newChannel))

  Seq WidgetTask
previousTasks <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasWidgetTasks s a => Lens' s a
L.widgetTasks
  forall s a. HasWidgetTasks s a => Lens' s a
L.widgetTasks forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Seq WidgetTask
previousTasks forall a. Seq a -> a -> Seq a
|> forall i.
Typeable i =>
WidgetId -> TChan i -> Async () -> WidgetTask
WidgetProducer WidgetId
widgetId TChan i
newChannel Async ()
asyncTask
  forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> m ()
setWidgetIdPath WidgetId
widgetId Path
path

  forall (m :: * -> *) a. Monad m => a -> m a
return HandlerStep s e
previousStep

handleRunInRenderThread
  :: forall s e m i . (MonomerM s e m, Typeable i)
  => WidgetId
  -> Path
  -> IO i
  -> HandlerStep s e
  -> m (HandlerStep s e)
handleRunInRenderThread :: forall s e (m :: * -> *) i.
(MonomerM s e m, Typeable i) =>
WidgetId -> Path -> IO i -> HandlerStep s e -> m (HandlerStep s e)
handleRunInRenderThread WidgetId
widgetId Path
path IO i
handler HandlerStep s e
previousStep = do
  Either Renderer (TChan (RenderMsg s e))
renderMethod <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasRenderMethod s a => Lens' s a
L.renderMethod

  IO i
task <- case Either Renderer (TChan (RenderMsg s e))
renderMethod of
    Left Renderer
renderer -> do
      -- Force running in main thread to avoid issues with OpenGL
      i
result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO i
handler
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return i
result)
    Right TChan (RenderMsg s e)
chan -> do
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall {s} {e}. TChan (RenderMsg s e) -> IO i
taskWrapper TChan (RenderMsg s e)
chan)

  forall s e (m :: * -> *) i.
(MonomerM s e m, Typeable i) =>
WidgetId -> Path -> IO i -> HandlerStep s e -> m (HandlerStep s e)
handleRunTask WidgetId
widgetId Path
path IO i
task HandlerStep s e
previousStep
  where
    taskWrapper :: TChan (RenderMsg s e) -> IO i
taskWrapper TChan (RenderMsg s e)
renderChannel = do
      TChan i
msgChan <- forall a. IO (TChan a)
newTChanIO
      forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> a -> STM ()
writeTChan TChan (RenderMsg s e)
renderChannel (forall s e i. TChan i -> IO i -> RenderMsg s e
MsgRunInRender TChan i
msgChan IO i
handler)
      forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> STM a
readTChan TChan i
msgChan

sendMessage :: TChan e -> e -> IO ()
sendMessage :: forall e. TChan e -> e -> IO ()
sendMessage TChan e
channel e
message = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> a -> STM ()
writeTChan TChan e
channel e
message

addFocusReq
  :: SystemEvent
  -> Seq (WidgetRequest s e)
  -> Seq (WidgetRequest s e)
addFocusReq :: forall s e.
SystemEvent -> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
addFocusReq (KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed) Seq (WidgetRequest s e)
reqs = Seq (WidgetRequest s e)
newReqs where
  isTabPressed :: Bool
isTabPressed = KeyCode -> Bool
isKeyTab KeyCode
code
  stopProcessing :: Bool
stopProcessing = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL forall s e. WidgetRequest s e -> Bool
isIgnoreParentEvents Seq (WidgetRequest s e)
reqs
  focusReqExists :: Bool
focusReqExists = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL forall s e. WidgetRequest s e -> Bool
isFocusRequest Seq (WidgetRequest s e)
reqs
  focusReqNeeded :: Bool
focusReqNeeded = Bool
isTabPressed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
stopProcessing Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
focusReqExists
  direction :: FocusDirection
direction
    | KeyMod
mod forall s a. s -> Getting a s a -> a
^. forall s a. HasLeftShift s a => Lens' s a
L.leftShift = FocusDirection
FocusBwd
    | Bool
otherwise = FocusDirection
FocusFwd
  newReqs :: Seq (WidgetRequest s e)
newReqs
    | Bool
focusReqNeeded = Seq (WidgetRequest s e)
reqs forall a. Seq a -> a -> Seq a
|> forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus forall a. Maybe a
Nothing FocusDirection
direction
    | Bool
otherwise = Seq (WidgetRequest s e)
reqs
addFocusReq SystemEvent
_ Seq (WidgetRequest s e)
reqs = Seq (WidgetRequest s e)
reqs

preProcessEvents :: [SystemEvent] -> [SystemEvent]
preProcessEvents :: [SystemEvent] -> [SystemEvent]
preProcessEvents [] = []
preProcessEvents (SystemEvent
e:[SystemEvent]
es) = case SystemEvent
e of
  WheelScroll Point
p Point
_ WheelDirection
_ -> SystemEvent
e forall a. a -> [a] -> [a]
: Point -> SystemEvent
Move Point
p forall a. a -> [a] -> [a]
: [SystemEvent] -> [SystemEvent]
preProcessEvents [SystemEvent]
es
  SystemEvent
_ -> SystemEvent
e forall a. a -> [a] -> [a]
: [SystemEvent] -> [SystemEvent]
preProcessEvents [SystemEvent]
es

addRelatedEvents
  :: MonomerM s e m
  => WidgetEnv s e
  -> Button
  -> WidgetNode s e
  -> SystemEvent
  -> m [(SystemEvent, Maybe Path)]
addRelatedEvents :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> Button
-> WidgetNode s e
-> SystemEvent
-> m [(SystemEvent, Maybe Path)]
addRelatedEvents WidgetEnv s e
wenv Button
mainBtn WidgetNode s e
widgetRoot SystemEvent
evt = case SystemEvent
evt of
  Move Point
point -> do
    (Maybe Path
target, [(SystemEvent, Maybe Path)]
hoverEvts) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e
-> Point
-> m (Maybe Path, [(SystemEvent, Maybe Path)])
addHoverEvents WidgetEnv s e
wenv WidgetNode s e
widgetRoot Point
point
    -- Update input status
    forall s e (m :: * -> *). MonomerM s e m => Point -> m ()
updateInputStatusMousePos Point
point
    -- Drag event
    Maybe (Path, Point)
mainPress <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress
    Maybe (Path, WidgetDragMsg)
draggedMsg <- forall s e (m :: * -> *).
MonomerM s e m =>
m (Maybe (Path, WidgetDragMsg))
getDraggedMsgInfo
    let pressed :: Maybe Path
pressed = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Maybe (Path, Point)
mainPress
    let isPressed :: Bool
isPressed = Maybe Path
target forall a. Eq a => a -> a -> Bool
== Maybe Path
pressed
    let dragEvts :: [(SystemEvent, Maybe Path)]
dragEvts = case Maybe (Path, WidgetDragMsg)
draggedMsg of
          Just (Path
path, WidgetDragMsg
msg) -> [(Point -> Path -> WidgetDragMsg -> SystemEvent
Drag Point
point Path
path WidgetDragMsg
msg, Maybe Path
target) | Bool -> Bool
not Bool
isPressed]
          Maybe (Path, WidgetDragMsg)
_ -> []

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (Path, Point)
mainPress Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (Path, WidgetDragMsg)
draggedMsg) forall a b. (a -> b) -> a -> b
$
      forall s a. HasRenderRequested s a => Lens' s a
L.renderRequested forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(SystemEvent, Maybe Path)]
hoverEvts forall a. [a] -> [a] -> [a]
++ [(SystemEvent, Maybe Path)]
dragEvts forall a. [a] -> [a] -> [a]
++ [(SystemEvent
evt, forall a. Maybe a
Nothing)]
  ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
_ -> do
    Maybe Path
overlay <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getOverlayPath
    let start :: Path
start = forall a. a -> Maybe a -> a
fromMaybe Path
emptyPath Maybe Path
overlay
    let widget :: Widget s e
widget = WidgetNode s e
widgetRoot forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
    let wni :: Maybe WidgetNodeInfo
wni = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
widgetRoot Path
start Point
point
    let curr :: Maybe Path
curr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) Maybe WidgetNodeInfo
wni

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Button
btn forall a. Eq a => a -> a -> Bool
== Button
mainBtn) forall a b. (a -> b) -> a -> b
$
      forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Point
point) Maybe Path
curr

    forall s e (m :: * -> *). MonomerM s e m => Point -> m ()
updateInputStatusMousePos Point
point
    forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasButtons s a => Lens' s a
L.buttons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Button
btn forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= ButtonState
BtnPressed

    forall (m :: * -> *). MonadIO m => Bool -> m CInt
SDLE.captureMouse Bool
True

    forall (m :: * -> *) a. Monad m => a -> m a
return [(SystemEvent
evt, forall a. Maybe a
Nothing)]
  ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks -> do
    -- Hover changes need to be handled here too
    Maybe (Path, Point)
mainPress <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress
    Maybe (Path, WidgetDragMsg)
draggedMsg <- forall s e (m :: * -> *).
MonomerM s e m =>
m (Maybe (Path, WidgetDragMsg))
getDraggedMsgInfo
    Maybe Path
overlay <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getOverlayPath

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Button
btn forall a. Eq a => a -> a -> Bool
== Button
mainBtn) forall a b. (a -> b) -> a -> b
$
      forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing

    (Maybe Path
target, [(SystemEvent, Maybe Path)]
hoverEvts) <- forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e
-> Point
-> m (Maybe Path, [(SystemEvent, Maybe Path)])
addHoverEvents WidgetEnv s e
wenv WidgetNode s e
widgetRoot Point
point

    let pressed :: Maybe Path
pressed = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Maybe (Path, Point)
mainPress
    let isPressed :: Bool
isPressed = Button
btn forall a. Eq a => a -> a -> Bool
== Button
mainBtn Bool -> Bool -> Bool
&& Maybe Path
target forall a. Eq a => a -> a -> Bool
== Maybe Path
pressed
    let clickEvt :: [(SystemEvent, Maybe Path)]
clickEvt = [(Point -> Button -> Int -> SystemEvent
Click Point
point Button
btn Int
clicks, Maybe Path
pressed) | Bool
isPressed Bool -> Bool -> Bool
|| Int
clicks forall a. Ord a => a -> a -> Bool
> Int
1]
    let releasedEvt :: [(SystemEvent, Maybe Path)]
releasedEvt = [(SystemEvent
evt, Maybe Path
pressed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Path
target forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Path
overlay)]
    let dropEvts :: [(SystemEvent, Maybe Path)]
dropEvts = case Maybe (Path, WidgetDragMsg)
draggedMsg of
          Just (Path
path, WidgetDragMsg
msg) -> [(Point -> Path -> WidgetDragMsg -> SystemEvent
Drop Point
point Path
path WidgetDragMsg
msg, Maybe Path
target) | Bool -> Bool
not Bool
isPressed]
          Maybe (Path, WidgetDragMsg)
_ -> []

    forall s e (m :: * -> *). MonomerM s e m => Point -> m ()
updateInputStatusMousePos Point
point
    forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasButtons s a => Lens' s a
L.buttons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Button
btn forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= ButtonState
BtnReleased

    forall (m :: * -> *). MonadIO m => Bool -> m CInt
SDLE.captureMouse Bool
False

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(SystemEvent, Maybe Path)]
releasedEvt forall a. [a] -> [a] -> [a]
++ [(SystemEvent, Maybe Path)]
dropEvts forall a. [a] -> [a] -> [a]
++ [(SystemEvent, Maybe Path)]
clickEvt forall a. [a] -> [a] -> [a]
++ [(SystemEvent, Maybe Path)]
hoverEvts
  KeyAction KeyMod
mod KeyCode
code KeyStatus
status -> do
    forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasKeyMod s a => Lens' s a
L.keyMod forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= KeyMod
mod
    forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasKeys s a => Lens' s a
L.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at KeyCode
code forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= KeyStatus
status

    forall (m :: * -> *) a. Monad m => a -> m a
return [(SystemEvent
evt, forall a. Maybe a
Nothing)]
  -- These handlers are only here to help with testing functions
  -- This will only be reached from `handleSystemEvents`
  Click Point
point Button
btn Int
clicks -> forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e
-> SystemEvent
-> Point
-> m [(SystemEvent, Maybe Path)]
findEvtTargetByPoint WidgetEnv s e
wenv WidgetNode s e
widgetRoot SystemEvent
evt Point
point
  SystemEvent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [(SystemEvent
evt, forall a. Maybe a
Nothing)]

updateInputStatusMousePos :: MonomerM s e m => Point -> m ()
updateInputStatusMousePos :: forall s e (m :: * -> *). MonomerM s e m => Point -> m ()
updateInputStatusMousePos Point
point = do
  -- Update input status
  InputStatus
status <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasInputStatus s a => Lens' s a
L.inputStatus
  forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePosPrev s a => Lens' s a
L.mousePosPrev forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= InputStatus
status forall s a. s -> Getting a s a -> a
^. forall s a. HasMousePos s a => Lens' s a
L.mousePos
  forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
point

addHoverEvents
  :: MonomerM s e m
  => WidgetEnv s e
  -> WidgetNode s e
  -> Point
  -> m (Maybe Path, [(SystemEvent, Maybe Path)])
addHoverEvents :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e
-> Point
-> m (Maybe Path, [(SystemEvent, Maybe Path)])
addHoverEvents WidgetEnv s e
wenv WidgetNode s e
widgetRoot Point
point = do
  Maybe Path
overlay <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getOverlayPath
  Maybe Path
hover <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getHoveredPath
  Maybe (Path, Point)
mainBtnPress <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress

  let start :: Path
start = forall a. a -> Maybe a -> a
fromMaybe Path
emptyPath Maybe Path
overlay
  let widget :: Widget s e
widget = WidgetNode s e
widgetRoot forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  let wni :: Maybe WidgetNodeInfo
wni = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
widgetRoot Path
start Point
point
  let target :: Maybe Path
target = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) Maybe WidgetNodeInfo
wni
  let hoverChanged :: Bool
hoverChanged = Maybe Path
target forall a. Eq a => a -> a -> Bool
/= Maybe Path
hover Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe (Path, Point)
mainBtnPress
  let enter :: [(SystemEvent, Maybe Path)]
enter = [(Point -> SystemEvent
Enter Point
point, Maybe Path
target) | forall a. Maybe a -> Bool
isJust Maybe Path
target Bool -> Bool -> Bool
&& Bool
hoverChanged]
  let leave :: [(SystemEvent, Maybe Path)]
leave = [(Point -> SystemEvent
Leave Point
point, Maybe Path
hover) | forall a. Maybe a -> Bool
isJust Maybe Path
hover Bool -> Bool -> Bool
&& Bool
hoverChanged]

  forall s a. HasLeaveEnterPair s a => Lens' s a
L.leaveEnterPair forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SystemEvent, Maybe Path)]
leave Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SystemEvent, Maybe Path)]
enter)

  forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Path
target, [(SystemEvent, Maybe Path)]
leave forall a. [a] -> [a] -> [a]
++ [(SystemEvent, Maybe Path)]
enter)

findEvtTargetByPoint
  :: MonomerM s e m
  => WidgetEnv s e
  -> WidgetNode s e
  -> SystemEvent
  -> Point
  -> m [(SystemEvent, Maybe Path)]
findEvtTargetByPoint :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetEnv s e
-> WidgetNode s e
-> SystemEvent
-> Point
-> m [(SystemEvent, Maybe Path)]
findEvtTargetByPoint WidgetEnv s e
wenv WidgetNode s e
widgetRoot SystemEvent
evt Point
point = do
  Maybe Path
overlay <- forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getOverlayPath
  let start :: Path
start = forall a. a -> Maybe a -> a
fromMaybe Path
emptyPath Maybe Path
overlay
  let widget :: Widget s e
widget = WidgetNode s e
widgetRoot forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  let wni :: Maybe WidgetNodeInfo
wni = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
widgetRoot Path
start Point
point
  let curr :: Maybe Path
curr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) Maybe WidgetNodeInfo
wni
  forall (m :: * -> *) a. Monad m => a -> m a
return [(SystemEvent
evt, Maybe Path
curr)]

findNextFocus
  :: WidgetEnv s e
  -> FocusDirection
  -> Path
  -> Maybe Path
  -> WidgetNode s e
  -> WidgetNodeInfo
findNextFocus :: forall s e.
WidgetEnv s e
-> FocusDirection
-> Path
-> Maybe Path
-> WidgetNode s e
-> WidgetNodeInfo
findNextFocus WidgetEnv s e
wenv FocusDirection
dir Path
start Maybe Path
overlay WidgetNode s e
widgetRoot = forall a. HasCallStack => Maybe a -> a
fromJust Maybe WidgetNodeInfo
nextFocus where
  widget :: Widget s e
widget = WidgetNode s e
widgetRoot forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  restartPath :: Path
restartPath = forall a. a -> Maybe a -> a
fromMaybe Path
emptyPath Maybe Path
overlay
  candidateWni :: Maybe WidgetNodeInfo
candidateWni = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
widgetFindNextFocus Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
widgetRoot FocusDirection
dir Path
start
  fromRootWni :: Maybe WidgetNodeInfo
fromRootWni = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
widgetFindNextFocus Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
widgetRoot FocusDirection
dir Path
restartPath
  focusWni :: WidgetNodeInfo
focusWni = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Maybe WidgetNodeInfo
findChildNodeInfoByPath WidgetEnv s e
wenv WidgetNode s e
widgetRoot Path
start)
  nextFocus :: Maybe WidgetNodeInfo
nextFocus = Maybe WidgetNodeInfo
candidateWni forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe WidgetNodeInfo
fromRootWni forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just WidgetNodeInfo
focusWni

dropNonParentWidgetId
  :: MonomerM s e m
  => WidgetId
  -> [(WidgetId, a)]
  -> m [(WidgetId, a)]
dropNonParentWidgetId :: forall s e (m :: * -> *) a.
MonomerM s e m =>
WidgetId -> [(WidgetId, a)] -> m [(WidgetId, a)]
dropNonParentWidgetId WidgetId
wid [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
dropNonParentWidgetId WidgetId
wid ((WidgetId, a)
x:[(WidgetId, a)]
xs) = do
  Path
path <- forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
wid
  Path
cpath <- forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
cwid

  if forall {a}. Eq a => Seq a -> Seq a -> Bool
isParentPath Path
cpath Path
path
    then forall (m :: * -> *) a. Monad m => a -> m a
return ((WidgetId, a)
xforall a. a -> [a] -> [a]
:[(WidgetId, a)]
xs)
    else forall s e (m :: * -> *) a.
MonomerM s e m =>
WidgetId -> [(WidgetId, a)] -> m [(WidgetId, a)]
dropNonParentWidgetId WidgetId
wid [(WidgetId, a)]
xs
  where
    (WidgetId
cwid, a
_) = (WidgetId, a)
x
    isParentPath :: Seq a -> Seq a -> Bool
isParentPath Seq a
parent Seq a
child = forall {a}. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Seq a
parent Seq a
child Bool -> Bool -> Bool
&& Seq a
parent forall a. Eq a => a -> a -> Bool
/= Seq a
child

resetCursorOnNodeLeave
  :: MonomerM s e m
  => SystemEvent
  -> HandlerStep s e
  -> m ()
resetCursorOnNodeLeave :: forall s e (m :: * -> *).
MonomerM s e m =>
SystemEvent -> HandlerStep s e -> m ()
resetCursorOnNodeLeave (Leave Point
point) HandlerStep s e
step = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> HandlerStep s e -> m (HandlerStep s e)
handleResetCursorIcon WidgetId
widgetId HandlerStep s e
step
  where
    (WidgetEnv s e
wenv, WidgetNode s e
root, Seq (WidgetRequest s e)
_) = HandlerStep s e
step
    widget :: Widget s e
widget = WidgetNode s e
root forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget

    childNode :: Maybe WidgetNodeInfo
childNode = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
root Path
emptyPath Point
point
    widgetId :: WidgetId
widgetId = case Maybe WidgetNodeInfo
childNode of
      Just WidgetNodeInfo
info -> WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      Maybe WidgetNodeInfo
Nothing -> WidgetNode s e
root forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
resetCursorOnNodeLeave SystemEvent
_ HandlerStep s e
step = forall (m :: * -> *) a. Monad m => a -> m a
return ()

restoreCursorOnWindowEnter :: MonomerM s e m => m ()
restoreCursorOnWindowEnter :: forall s e (m :: * -> *). MonomerM s e m => m ()
restoreCursorOnWindowEnter = do
  -- Restore old icon if needed
  Size Double
ww Double
wh <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasWindowSize s a => Lens' s a
L.windowSize
  InputStatus
status <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasInputStatus s a => Lens' s a
L.inputStatus
  Map CursorIcon Cursor
cursorIcons <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasCursorIcons s a => Lens' s a
L.cursorIcons
  Maybe (WidgetId, CursorIcon)
cursorPair <- forall a. [a] -> Maybe a
headMay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasCursorStack s a => Lens' s a
L.cursorStack

  let windowRect :: Rect
windowRect = Double -> Double -> Double -> Double -> Rect
Rect Double
0 Double
0 Double
ww Double
wh
  let prevInside :: Bool
prevInside = Point -> Rect -> Bool
pointInRect (InputStatus
status forall s a. s -> Getting a s a -> a
^. forall s a. HasMousePosPrev s a => Lens' s a
L.mousePosPrev) Rect
windowRect
  let currInside :: Bool
currInside = Point -> Rect -> Bool
pointInRect (InputStatus
status forall s a. s -> Getting a s a -> a
^. forall s a. HasMousePos s a => Lens' s a
L.mousePos) Rect
windowRect
  let sdlCursor :: Maybe Cursor
sdlCursor = Maybe (WidgetId, CursorIcon)
cursorPair forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map CursorIcon Cursor
cursorIcons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe Cursor
sdlCursor Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe (WidgetId, CursorIcon)
cursorPair) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLnErr forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid restoreCursorOnWindowEnter: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Maybe (WidgetId, CursorIcon)
cursorPair

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
prevInside Bool -> Bool -> Bool
&& Bool
currInside Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe Cursor
sdlCursor) forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). MonadIO m => Cursor -> m ()
SDLE.setCursor (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Cursor
sdlCursor)

getTargetPath
  :: WidgetEnv s e
  -> WidgetNode s e
  -> Maybe Path
  -> Maybe Path
  -> Path
  -> SystemEvent
  -> Maybe Path
getTargetPath :: forall s e.
WidgetEnv s e
-> WidgetNode s e
-> Maybe Path
-> Maybe Path
-> Path
-> SystemEvent
-> Maybe Path
getTargetPath WidgetEnv s e
wenv WidgetNode s e
root Maybe Path
pressed Maybe Path
overlay Path
target SystemEvent
event = case SystemEvent
event of
    -- Keyboard
    KeyAction{}                       -> forall a. a -> Maybe a
pathEvent Path
target
    TextInput Text
_                       -> forall a. a -> Maybe a
pathEvent Path
target
    -- Clipboard
    Clipboard ClipboardData
_                       -> forall a. a -> Maybe a
pathEvent Path
target
    -- Mouse/touch
    ButtonAction Point
point Button
_ ButtonState
BtnPressed Int
_ -> Point -> Maybe Path
pointEvent Point
point
    ButtonAction Point
_ Button
_ ButtonState
BtnReleased Int
_    -> forall a. a -> Maybe a
pathEvent Path
target
    Click{}                           -> forall a. a -> Maybe a
pathEvent Path
target
    WheelScroll Point
point Point
_ WheelDirection
_             -> Point -> Maybe Path
pointEvent Point
point
    Focus{}                           -> forall a. a -> Maybe a
pathEvent Path
target
    Blur{}                            -> forall a. a -> Maybe a
pathEvent Path
target
    Enter{}                           -> forall a. a -> Maybe a
pathEvent Path
target
    Move Point
point                        -> Point -> Maybe Path
pointEvent Point
point
    Leave{}                           -> forall a. a -> Maybe a
pathEvent Path
target
    -- Drag/drop
    Drag Point
point Path
_ WidgetDragMsg
_                    -> Point -> Maybe Path
pointEvent Point
point
    Drop Point
point Path
_ WidgetDragMsg
_                    -> Point -> Maybe Path
pointEvent Point
point
  where
    widget :: Widget s e
widget = WidgetNode s e
root forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
    startPath :: Path
startPath = forall a. a -> Maybe a -> a
fromMaybe Path
emptyPath Maybe Path
overlay
    pathEvent :: a -> Maybe a
pathEvent = forall a. a -> Maybe a
Just
    pathFromPoint :: Point -> Maybe Path
pathFromPoint Point
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) Maybe WidgetNodeInfo
wni where
      wni :: Maybe WidgetNodeInfo
wni = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
root Path
startPath Point
p
    -- pressed is only really used for Move
    pointEvent :: Point -> Maybe Path
pointEvent Point
point = Maybe Path
pressed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Point -> Maybe Path
pathFromPoint Point
point forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Path
overlay

cursorToSDL :: CursorIcon -> SDLEnum.SystemCursor
cursorToSDL :: CursorIcon -> SystemCursor
cursorToSDL CursorIcon
CursorArrow = SystemCursor
SDLEnum.SDL_SYSTEM_CURSOR_ARROW
cursorToSDL CursorIcon
CursorHand = SystemCursor
SDLEnum.SDL_SYSTEM_CURSOR_HAND
cursorToSDL CursorIcon
CursorIBeam = SystemCursor
SDLEnum.SDL_SYSTEM_CURSOR_IBEAM
cursorToSDL CursorIcon
CursorInvalid = SystemCursor
SDLEnum.SDL_SYSTEM_CURSOR_NO
cursorToSDL CursorIcon
CursorSizeH = SystemCursor
SDLEnum.SDL_SYSTEM_CURSOR_SIZEWE
cursorToSDL CursorIcon
CursorSizeV = SystemCursor
SDLEnum.SDL_SYSTEM_CURSOR_SIZENS
cursorToSDL CursorIcon
CursorDiagTL = SystemCursor
SDLEnum.SDL_SYSTEM_CURSOR_SIZENWSE
cursorToSDL CursorIcon
CursorDiagTR = SystemCursor
SDLEnum.SDL_SYSTEM_CURSOR_SIZENESW