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

Helper functions for the Main module.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE Strict #-}

module Monomer.Main.Util where

import Control.Applicative ((<|>))
import Control.Concurrent.STM.TChan
import Control.Lens ((&), (^.), (.=), (%=), ix, at, non, use, _1)
import Control.Monad.Extra
import Control.Monad.State
import Data.Default
import Data.Maybe

import qualified Data.Sequence as Seq
import qualified Data.Map as Map
import qualified SDL

import Monomer.Core
import Monomer.Event
import Monomer.Helper (headMay)
import Monomer.Main.Platform
import Monomer.Main.Types
import Monomer.Widgets.Util.Widget

import qualified Monomer.Core.Lens as L
import qualified Monomer.Main.Lens as L

-- | Initializes the Monomer context with the provided information.
initMonomerCtx
  :: SDL.Window
  -> TChan (RenderMsg s e)
  -> Size
  -> Double
  -> Double
  -> s
  -> MonomerCtx s e
initMonomerCtx :: forall s e.
Window
-> TChan (RenderMsg s e)
-> Size
-> Double
-> Double
-> s
-> MonomerCtx s e
initMonomerCtx ~Window
win TChan (RenderMsg s e)
channel Size
winSize Double
dpr Double
epr s
model = MonomerCtx {
  _mcMainModel :: s
_mcMainModel = s
model,
  _mcWindow :: Window
_mcWindow = Window
win,
  _mcWindowSize :: Size
_mcWindowSize = Size
winSize,
  _mcDpr :: Double
_mcDpr = Double
dpr,
  _mcEpr :: Double
_mcEpr = Double
epr,
  _mcRenderMethod :: Either Renderer (TChan (RenderMsg s e))
_mcRenderMethod = forall a b. b -> Either a b
Right TChan (RenderMsg s e)
channel,
  _mcInputStatus :: InputStatus
_mcInputStatus = forall a. Default a => a
def,
  _mcCursorStack :: [(WidgetId, CursorIcon)]
_mcCursorStack = [],
  _mcFocusedWidgetId :: WidgetId
_mcFocusedWidgetId = forall a. Default a => a
def,
  _mcHoveredWidgetId :: Maybe WidgetId
_mcHoveredWidgetId = forall a. Maybe a
Nothing,
  _mcOverlayWidgetId :: Maybe WidgetId
_mcOverlayWidgetId = forall a. Maybe a
Nothing,
  _mcDragAction :: Maybe DragAction
_mcDragAction = forall a. Maybe a
Nothing,
  _mcMainBtnPress :: Maybe (Path, Point)
_mcMainBtnPress = forall a. Maybe a
Nothing,
  _mcWidgetTasks :: Seq WidgetTask
_mcWidgetTasks = forall a. Seq a
Seq.empty,
  _mcWidgetPaths :: Map WidgetId Path
_mcWidgetPaths = forall k a. Map k a
Map.empty,
  _mcCursorIcons :: Map CursorIcon Cursor
_mcCursorIcons = forall k a. Map k a
Map.empty,
  _mcLeaveEnterPair :: Bool
_mcLeaveEnterPair = Bool
False,
  _mcResizeRequests :: Seq WidgetId
_mcResizeRequests = forall a. Seq a
Seq.empty,
  _mcRenderRequested :: Bool
_mcRenderRequested = Bool
False,
  _mcRenderSchedule :: Map WidgetId RenderSchedule
_mcRenderSchedule = forall k a. Map k a
Map.empty,
  _mcExitApplication :: Bool
_mcExitApplication = Bool
False
}

-- | Returns the path of the provided "WidgetId".
getWidgetIdPath :: (MonomerM s e m) => WidgetId -> m Path
getWidgetIdPath :: forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
widgetId =
  forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ forall s a. HasWidgetPaths s a => Lens' s a
L.widgetPaths forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at WidgetId
widgetId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (WidgetId
widgetId forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path)

-- | Updates the path associated to a "WidgetId".
setWidgetIdPath :: (MonomerM s e m) => WidgetId -> Path -> m ()
setWidgetIdPath :: forall s e (m :: * -> *).
MonomerM s e m =>
WidgetId -> Path -> m ()
setWidgetIdPath WidgetId
widgetId Path
path = forall s a. HasWidgetPaths s a => Lens' s a
L.widgetPaths forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at WidgetId
widgetId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Path
path

-- | Removes the association of a path to a "WidgetId".
delWidgetIdPath :: (MonomerM s e m) => WidgetId -> m ()
delWidgetIdPath :: forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m ()
delWidgetIdPath WidgetId
widgetId = forall s a. HasWidgetPaths s a => Lens' s a
L.widgetPaths forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at WidgetId
widgetId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing

-- | Returns the path of the currently hovered node, if any.
getHoveredPath :: (MonomerM s e m) => m (Maybe Path)
getHoveredPath :: forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getHoveredPath = do
  Maybe WidgetId
hoveredWidgetId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasHoveredWidgetId s a => Lens' s a
L.hoveredWidgetId
  case Maybe WidgetId
hoveredWidgetId of
    Just WidgetId
wid -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
wid
    Maybe WidgetId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Returns the path of the currently focused node.
getFocusedPath :: (MonomerM s e m) => m Path
getFocusedPath :: forall s e (m :: * -> *). MonomerM s e m => m Path
getFocusedPath = forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall s a. HasFocusedWidgetId s a => Lens' s a
L.focusedWidgetId

-- | Returns the path of the current overlay node, if any.
getOverlayPath :: (MonomerM s e m) => m (Maybe Path)
getOverlayPath :: forall s e (m :: * -> *). MonomerM s e m => m (Maybe Path)
getOverlayPath = do
  Maybe WidgetId
overlayWidgetId <- 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
  case Maybe WidgetId
overlayWidgetId of
    Just WidgetId
wid -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
wid
    Maybe WidgetId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Returns the current drag message and path, if any.
getDraggedMsgInfo :: (MonomerM s e m) => m (Maybe (Path, WidgetDragMsg))
getDraggedMsgInfo :: forall s e (m :: * -> *).
MonomerM s e m =>
m (Maybe (Path, WidgetDragMsg))
getDraggedMsgInfo = 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
  case Maybe DragAction
dragAction of
    Just (DragAction WidgetId
wid WidgetDragMsg
msg) -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, WidgetDragMsg
msg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
wid
    Maybe DragAction
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Returns the current cursor and path that set it, if any.
getCurrentCursorIcon :: (MonomerM s e m) => m (Maybe (Path, CursorIcon))
getCurrentCursorIcon :: forall s e (m :: * -> *).
MonomerM s e m =>
m (Maybe (Path, CursorIcon))
getCurrentCursorIcon = do
  Maybe (WidgetId, CursorIcon)
cursorHead <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Maybe a
headMay (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)
  case Maybe (WidgetId, CursorIcon)
cursorHead of
    Just (WidgetId
wid, CursorIcon
icon) -> do
      Path
path <- forall s e (m :: * -> *). MonomerM s e m => WidgetId -> m Path
getWidgetIdPath WidgetId
wid
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Path
path, CursorIcon
icon)
    Maybe (WidgetId, CursorIcon)
otherwhise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing