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

Layered container, stacking children one on top of the other. Useful for
handling widgets that need to be visible in certain contexts only, such as
dialogs, or to overlay unrelated widgets (text on top of an image).

The order of the widgets is from bottom to top.

The container will request the largest combination of horizontal and vertical
size requested by its child nodes.

@
zstack [
    image_ "assets/test-image.png" [fitFill],
    label "Image caption"
      \`styleBasic\` [textFont \"Bold\", textSize 20, textCenter]
  ]
@
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Containers.ZStack (
  -- * Configuration
  ZStackCfg,
  onlyTopActive,
  onlyTopActive_,
  -- * Constructors
  zstack,
  zstack_
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (^?), (.~), (%~), (?~), at, ix)
import Control.Monad (forM_, void, when)
import Data.Default
import Data.Maybe
import Data.List (foldl', any)
import Data.Sequence (Seq(..), (<|), (|>))
import GHC.Generics

import qualified Data.Map.Strict as M
import qualified Data.Sequence as Seq

import Monomer.Widgets.Container

import qualified Monomer.Lens as L

{-|
Configuration options for zstack:

- 'onlyTopActive': whether the top visible node is the only node that may
  receive events.
-}
newtype ZStackCfg = ZStackCfg {
  ZStackCfg -> Maybe Bool
_zscOnlyTopActive :: Maybe Bool
}

instance Default ZStackCfg where
  def :: ZStackCfg
def = Maybe Bool -> ZStackCfg
ZStackCfg forall a. Maybe a
Nothing

instance Semigroup ZStackCfg where
  <> :: ZStackCfg -> ZStackCfg -> ZStackCfg
(<>) ZStackCfg
z1 ZStackCfg
z2 = ZStackCfg {
    _zscOnlyTopActive :: Maybe Bool
_zscOnlyTopActive = ZStackCfg -> Maybe Bool
_zscOnlyTopActive ZStackCfg
z2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ZStackCfg -> Maybe Bool
_zscOnlyTopActive ZStackCfg
z1
  }

instance Monoid ZStackCfg where
  mempty :: ZStackCfg
mempty = forall a. Default a => a
def

-- | Makes the top visible node the only node that may receive events.
onlyTopActive :: ZStackCfg
onlyTopActive :: ZStackCfg
onlyTopActive = Bool -> ZStackCfg
onlyTopActive_ Bool
True

-- | Whether the top visible node is the only node that may receive events.
onlyTopActive_ :: Bool -> ZStackCfg
onlyTopActive_ :: Bool -> ZStackCfg
onlyTopActive_ Bool
active = forall a. Default a => a
def {
  _zscOnlyTopActive :: Maybe Bool
_zscOnlyTopActive = forall a. a -> Maybe a
Just Bool
active
}

data ZStackState = ZStackState {
  ZStackState -> Map PathStep WidgetId
_zssFocusMap :: M.Map PathStep WidgetId,
  ZStackState -> PathStep
_zssTopIdx :: Int
} deriving (ZStackState -> ZStackState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZStackState -> ZStackState -> Bool
$c/= :: ZStackState -> ZStackState -> Bool
== :: ZStackState -> ZStackState -> Bool
$c== :: ZStackState -> ZStackState -> Bool
Eq, PathStep -> ZStackState -> ShowS
[ZStackState] -> ShowS
ZStackState -> String
forall a.
(PathStep -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZStackState] -> ShowS
$cshowList :: [ZStackState] -> ShowS
show :: ZStackState -> String
$cshow :: ZStackState -> String
showsPrec :: PathStep -> ZStackState -> ShowS
$cshowsPrec :: PathStep -> ZStackState -> ShowS
Show, forall x. Rep ZStackState x -> ZStackState
forall x. ZStackState -> Rep ZStackState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ZStackState x -> ZStackState
$cfrom :: forall x. ZStackState -> Rep ZStackState x
Generic)

-- | Creates a zstack container with the provided nodes.
zstack :: (Traversable t) => t (WidgetNode s e) -> WidgetNode s e
zstack :: forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
zstack t (WidgetNode s e)
children = forall (t :: * -> *) s e.
Traversable t =>
[ZStackCfg] -> t (WidgetNode s e) -> WidgetNode s e
zstack_ forall a. Default a => a
def t (WidgetNode s e)
children

-- | Creates a zstack container with the provided nodes. Accepts config.
zstack_
  :: (Traversable t)
  => [ZStackCfg]
  -> t (WidgetNode s e)
  -> WidgetNode s e
zstack_ :: forall (t :: * -> *) s e.
Traversable t =>
[ZStackCfg] -> t (WidgetNode s e) -> WidgetNode s e
zstack_ [ZStackCfg]
configs t (WidgetNode s e)
children = WidgetNode s e
newNode where
  config :: ZStackCfg
config = forall a. Monoid a => [a] -> a
mconcat [ZStackCfg]
configs
  state :: ZStackState
state = Map PathStep WidgetId -> PathStep -> ZStackState
ZStackState forall k a. Map k a
M.empty PathStep
0
  newNode :: WidgetNode s e
newNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"zstack" (forall s e. ZStackCfg -> ZStackState -> Widget s e
makeZStack ZStackCfg
config ZStackState
state)
    forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Seq a -> Seq a
Seq.reverse (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Seq a -> a -> Seq a
(|>) forall a. Seq a
Empty t (WidgetNode s e)
children)

makeZStack :: ZStackCfg -> ZStackState -> Widget s e
makeZStack :: forall s e. ZStackCfg -> ZStackState -> Widget s e
makeZStack ZStackCfg
config ZStackState
state = forall {s} {e}. Widget s e
widget where
  baseWidget :: Widget s e
baseWidget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer ZStackState
state forall a. Default a => a
def {
    containerUseChildrenSizes :: Bool
containerUseChildrenSizes = Bool
True,
    containerInit :: ContainerInitHandler s e
containerInit = forall {p} {a} {s} {e}.
HasFocusedPath p a =>
p -> WidgetNode s e -> WidgetResult s e
init,
    containerMergePost :: ContainerMergePostHandler s e ZStackState
containerMergePost = forall {p} {s} {e} {a} {s} {e} {s} {e} {s} {e} {p}.
(HasRequests p (Seq (WidgetRequest s e)), HasNode p a,
 HasWidget a (Widget s e),
 HasRequests p (Seq (WidgetRequest s e))) =>
WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> ZStackState -> p -> p -> p
mergePost,
    containerFindNextFocus :: ContainerFindNextFocusHandler s e
containerFindNextFocus = forall {p} {s} {e} {p} {p} {p}.
HasChildren p (Seq (WidgetNode s e)) =>
p -> p -> p -> p -> Seq (WidgetNode s e)
findNextFocus,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = forall {p} {p} {s} {e}.
p -> p -> Seq (WidgetNode s e) -> (SizeReq, SizeReq)
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = forall {f :: * -> *} {s} {e} {a}.
Functor f =>
WidgetEnv s e
-> WidgetNode s e -> Rect -> f a -> (WidgetResult s e, f Rect)
resize
  }
  widget :: Widget s e
widget = forall {s} {e}. Widget s e
baseWidget {
    widgetFindByPoint :: WidgetEnv s e
-> WidgetNode s e -> Path -> Point -> Maybe WidgetNodeInfo
widgetFindByPoint = forall {s} {e}.
WidgetEnv s e
-> WidgetNode s e -> Path -> Point -> Maybe WidgetNodeInfo
findByPoint,
    widgetRender :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
  }

  onlyTopActive :: Bool
onlyTopActive = forall a. a -> Maybe a -> a
fromMaybe Bool
True (ZStackCfg -> Maybe Bool
_zscOnlyTopActive ZStackCfg
config)

  init :: p -> WidgetNode s e -> WidgetResult s e
init p
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
    focusedPath :: a
focusedPath = p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath
    newState :: ZStackState
newState = ZStackState
state {
      _zssTopIdx :: PathStep
_zssTopIdx = forall a. a -> Maybe a -> a
fromMaybe PathStep
0 (forall a. (a -> Bool) -> Seq a -> Maybe PathStep
Seq.findIndexL (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. HasVisible s a => Lens' s a
L.visible) Seq (WidgetNode s e)
children)
    }
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. ZStackCfg -> ZStackState -> Widget s e
makeZStack ZStackCfg
config ZStackState
newState

  mergePost :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> ZStackState -> p -> p -> p
mergePost WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
oldNode ZStackState
oldState p
newState p
result = p
newResult where
    ZStackState Map PathStep WidgetId
oldFocusMap PathStep
oldTopIdx = ZStackState
oldState
    children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
    focusedPath :: Path
focusedPath = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath
    focusedWid :: Maybe WidgetId
focusedWid = forall s e. WidgetEnv s e -> Path -> Maybe WidgetId
widgetIdFromPath WidgetEnv s e
wenv Path
focusedPath
    isFocusParent :: Bool
isFocusParent = forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath WidgetNode s e
node Path
focusedPath

    topLevel :: Bool
topLevel = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTopLevel WidgetEnv s e
wenv WidgetNode s e
node
    flagsChanged :: Bool
flagsChanged = forall s e. WidgetNode s e -> WidgetNode s e -> Bool
childrenFlagsChanged WidgetNode s e
oldNode WidgetNode s e
node
    newTopIdx :: PathStep
newTopIdx = forall a. a -> Maybe a -> a
fromMaybe PathStep
0 (forall a. (a -> Bool) -> Seq a -> Maybe PathStep
Seq.findIndexL (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. HasVisible s a => Lens' s a
L.visible) Seq (WidgetNode s e)
children)
    focusReq :: Bool
focusReq = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Maybe PathStep
Seq.findIndexL forall s e. WidgetRequest s e -> Bool
isFocusRequest (p
result forall s a. s -> Getting a s a -> a
^. forall s a. HasRequests s a => Lens' s a
L.requests)
    needsFocus :: Bool
needsFocus = Bool
isFocusParent Bool -> Bool -> Bool
&& Bool
topLevel Bool -> Bool -> Bool
&& Bool
flagsChanged Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
focusReq

    oldTopWid :: Maybe WidgetId
oldTopWid = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PathStep
newTopIdx Map PathStep WidgetId
oldFocusMap
    fstTopWid :: Maybe WidgetId
fstTopWid = WidgetNode s e
node forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix PathStep
newTopIdx forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    newState :: ZStackState
newState = ZStackState
oldState {
      _zssFocusMap :: Map PathStep WidgetId
_zssFocusMap = Map PathStep WidgetId
oldFocusMap forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at PathStep
oldTopIdx forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe WidgetId
focusedWid,
      _zssTopIdx :: PathStep
_zssTopIdx = PathStep
newTopIdx
    }

    tmpResult :: p
tmpResult = p
result
      forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. ZStackCfg -> ZStackState -> Widget s e
makeZStack ZStackCfg
config ZStackState
newState
    newResult :: p
newResult
      | Bool
needsFocus Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe WidgetId
oldTopWid = p
tmpResult
          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 a. Seq a -> a -> Seq a
|> forall s e. WidgetId -> WidgetRequest s e
SetFocus (forall a. HasCallStack => Maybe a -> a
fromJust Maybe WidgetId
oldTopWid))
      | Bool
needsFocus = p
tmpResult
          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 a. Seq a -> a -> Seq a
|> forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus Maybe WidgetId
fstTopWid FocusDirection
FocusFwd)
      | Bool
isFocusParent = p
tmpResult
      | Bool
otherwise = p
result

  -- | Find instance matching point
  findByPoint :: WidgetEnv s e
-> WidgetNode s e -> Path -> Point -> Maybe WidgetNodeInfo
findByPoint WidgetEnv s e
wenv WidgetNode s e
node Path
start Point
point = Maybe WidgetNodeInfo
result where
    children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
    vchildren :: Seq (WidgetNode s e)
vchildren
      | Bool
onlyTopActive = forall a. PathStep -> Seq a -> Seq a
Seq.take PathStep
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNodeInfo -> Bool
_wniVisible forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children
      | Bool
otherwise = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNodeInfo -> Bool
_wniVisible forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children

    nextStep :: Maybe PathStep
nextStep = forall s e. WidgetNode s e -> Path -> Maybe PathStep
nextTargetStep WidgetNode s e
node Path
start
    ch :: WidgetNode s e
ch = forall a. Seq a -> PathStep -> a
Seq.index Seq (WidgetNode s e)
children (forall a. HasCallStack => Maybe a -> a
fromJust Maybe PathStep
nextStep)
    visible :: Bool
visible = WidgetNode s e
node 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. HasVisible s a => Lens' s a
L.visible
    childVisible :: Bool
childVisible = WidgetNode s e
ch 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. HasVisible s a => Lens' s a
L.visible
    isNextValid :: Bool
isNextValid = forall a. Maybe a -> Bool
isJust Maybe PathStep
nextStep Bool -> Bool -> Bool
&& Bool
visible Bool -> Bool -> Bool
&& Bool
childVisible
    result :: Maybe WidgetNodeInfo
result
      | Bool
isNextValid = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint (WidgetNode s e
ch forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
ch Path
start Point
point
      | Bool
visible = forall s e.
Seq (WidgetNode s e)
-> WidgetEnv s e -> Path -> Point -> Maybe WidgetNodeInfo
findFirstByPoint Seq (WidgetNode s e)
vchildren WidgetEnv s e
wenv Path
start Point
point
      | Bool
otherwise = forall a. Maybe a
Nothing

  findNextFocus :: p -> p -> p -> p -> Seq (WidgetNode s e)
findNextFocus p
wenv p
node p
direction p
start = Seq (WidgetNode s e)
result where
    children :: Seq (WidgetNode s e)
children = p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
    vchildren :: Seq (WidgetNode s e)
vchildren = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNodeInfo -> Bool
_wniVisible forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children
    result :: Seq (WidgetNode s e)
result
      | Bool
onlyTopActive = forall a. PathStep -> Seq a -> Seq a
Seq.take PathStep
1 Seq (WidgetNode s e)
vchildren
      | Bool
otherwise = Seq (WidgetNode s e)
vchildren

  getSizeReq :: p -> p -> Seq (WidgetNode s e) -> (SizeReq, SizeReq)
getSizeReq p
wenv p
node Seq (WidgetNode s e)
children = (SizeReq
newSizeReqW, SizeReq
newSizeReqH) where
    vchildren :: Seq (WidgetNode s e)
vchildren = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNodeInfo -> Bool
_wniVisible forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children
    newSizeReqW :: SizeReq
newSizeReqW = forall {a}. (a -> SizeReq) -> Seq a -> SizeReq
getDimSizeReq (WidgetNodeInfo -> SizeReq
_wniSizeReqW forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
vchildren
    newSizeReqH :: SizeReq
newSizeReqH = forall {a}. (a -> SizeReq) -> Seq a -> SizeReq
getDimSizeReq (WidgetNodeInfo -> SizeReq
_wniSizeReqH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
vchildren

  getDimSizeReq :: (a -> SizeReq) -> Seq a -> SizeReq
getDimSizeReq a -> SizeReq
accesor Seq a
vchildren
    | forall a. Seq a -> Bool
Seq.null Seq SizeReq
vreqs = Double -> SizeReq
fixedSize Double
0
    | Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax Seq SizeReq
vreqs
    where
      vreqs :: Seq SizeReq
vreqs = a -> SizeReq
accesor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq a
vchildren

  resize :: WidgetEnv s e
-> WidgetNode s e -> Rect -> f a -> (WidgetResult s e, f Rect)
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport f a
children = (WidgetResult s e, f Rect)
resized where
    style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    vpChild :: Rect
vpChild = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
    assignedAreas :: f Rect
assignedAreas = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Rect
vpChild) f a
children
    resized :: (WidgetResult s e, f Rect)
resized = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, f Rect
assignedAreas)

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer =
    Renderer -> Bool -> Rect -> IO () -> IO ()
drawInScissor Renderer
renderer Bool
True Rect
viewport forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction Renderer
renderer Rect
viewport StyleState
style forall a b. (a -> b) -> a -> b
$ \Rect
_ ->
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Applicative f =>
(PathStep -> a -> f b) -> Seq a -> f (Seq b)
Seq.traverseWithIndex PathStep -> WidgetNode s e -> IO ()
renderChild Seq (WidgetNode s e)
children
    where
      style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      children :: Seq (WidgetNode s e)
children = forall a. Seq a -> Seq a
Seq.reverse forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
      viewport :: Rect
viewport = WidgetNode s e
node 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. HasViewport s a => Lens' s a
L.viewport
      isVisible :: s -> a
isVisible s
c = s
c 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. HasVisible s a => Lens' s a
L.visible
      topVisibleIdx :: PathStep
topVisibleIdx = forall a. a -> Maybe a -> a
fromMaybe PathStep
0 (forall a. (a -> Bool) -> Seq a -> Maybe PathStep
Seq.findIndexR (WidgetNodeInfo -> Bool
_wniVisible forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children)

      isPointEmpty :: Point -> PathStep -> Bool
isPointEmpty Point
point PathStep
idx = Bool -> Bool
not Bool
covered where
        prevs :: Seq (WidgetNode s e)
prevs = forall a. PathStep -> Seq a -> Seq a
Seq.drop (PathStep
idx forall a. Num a => a -> a -> a
+ PathStep
1) Seq (WidgetNode s e)
children
        target :: WidgetNode s e -> Maybe WidgetNodeInfo
target WidgetNode s e
c = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint (WidgetNode s e
c forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
c Path
emptyPath Point
point
        isCovered :: WidgetNode s e -> Bool
isCovered WidgetNode s e
c = forall {s} {a} {a}. (HasInfo s a, HasVisible a a) => s -> a
isVisible WidgetNode s e
c Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust (WidgetNode s e -> Maybe WidgetNodeInfo
target WidgetNode s e
c)
        covered :: Bool
covered = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any WidgetNode s e -> Bool
isCovered Seq (WidgetNode s e)
prevs

      isTopLayer :: PathStep -> p -> Point -> Bool
isTopLayer PathStep
idx p
child Point
point = Bool
prevTopLayer Bool -> Bool -> Bool
&& Bool
isValid where
        prevTopLayer :: Bool
prevTopLayer = forall s e. WidgetEnv s e -> Point -> Bool
_weInTopLayer WidgetEnv s e
wenv Point
point
        isValid :: Bool
isValid
          | Bool
onlyTopActive = PathStep
idx forall a. Eq a => a -> a -> Bool
== PathStep
topVisibleIdx
          | Bool
otherwise = Point -> PathStep -> Bool
isPointEmpty Point
point PathStep
idx

      cWenv :: PathStep -> p -> WidgetEnv s e
cWenv PathStep
idx p
child = WidgetEnv s e
wenv {
        _weInTopLayer :: Point -> Bool
_weInTopLayer = forall {p}. PathStep -> p -> Point -> Bool
isTopLayer PathStep
idx p
child
      }
      renderChild :: PathStep -> WidgetNode s e -> IO ()
renderChild PathStep
idx WidgetNode s e
child = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {s} {a} {a}. (HasInfo s a, HasVisible a a) => s -> a
isVisible WidgetNode s e
child) forall a b. (a -> b) -> a -> b
$
        forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) (forall {p}. PathStep -> p -> WidgetEnv s e
cWenv PathStep
idx WidgetNode s e
child) WidgetNode s e
child Renderer
renderer

findFirstByPoint
  :: Seq (WidgetNode s e)
  -> WidgetEnv s e
  -> Seq PathStep
  -> Point
  -> Maybe WidgetNodeInfo
findFirstByPoint :: forall s e.
Seq (WidgetNode s e)
-> WidgetEnv s e -> Path -> Point -> Maybe WidgetNodeInfo
findFirstByPoint Seq (WidgetNode s e)
Empty WidgetEnv s e
_ Path
_ Point
_ = forall a. Maybe a
Nothing
findFirstByPoint (WidgetNode s e
ch :<| Seq (WidgetNode s e)
chs) WidgetEnv s e
wenv Path
start Point
point = Maybe WidgetNodeInfo
result where
  isVisible :: Bool
isVisible = WidgetNode s e
ch 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. HasVisible s a => Lens' s a
L.visible
  newPath :: Maybe WidgetNodeInfo
newPath = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint (WidgetNode s e
ch forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
ch Path
start Point
point
  result :: Maybe WidgetNodeInfo
result
    | Bool
isVisible Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe WidgetNodeInfo
newPath = Maybe WidgetNodeInfo
newPath
    | Bool
otherwise = forall s e.
Seq (WidgetNode s e)
-> WidgetEnv s e -> Path -> Point -> Maybe WidgetNodeInfo
findFirstByPoint Seq (WidgetNode s e)
chs WidgetEnv s e
wenv Path
start Point
point