{-# LANGUAGE Strict #-}
module Monomer.Widgets.Util.Hover (
isPointInNodeVp,
isPointInNodeEllipse,
isNodeActive,
isNodeInfoActive,
isNodePressed,
isNodeInfoPressed,
isNodeTreeActive,
isNodeTreePressed,
isNodeDragged,
isNodeInfoDragged,
isNodeHovered,
isNodeInfoHovered,
isNodeHoveredEllipse_,
isNodeTopLevel,
isNodeInfoTopLevel,
isNodeInOverlay,
isNodeInfoInOverlay
) where
import Control.Lens ((&), (^.), (^?), _1, _Just)
import Data.Maybe
import qualified Data.Sequence as Seq
import Monomer.Core
import Monomer.Helper
import qualified Monomer.Core.Lens as L
import qualified Monomer.Event.Lens as L
isPointInNodeVp :: WidgetNode s e -> Point -> Bool
isPointInNodeVp :: forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
p = Point -> Rect -> Bool
pointInRect Point
p (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)
isPointInNodeEllipse :: WidgetNode s e -> Point -> Bool
isPointInNodeEllipse :: forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeEllipse WidgetNode s e
node Point
p = Point -> Rect -> Bool
pointInEllipse Point
p (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)
isNodeActive :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeActive :: forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeActive WidgetEnv s e
wenv WidgetNode s e
node = forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoActive Bool
False WidgetEnv s e
wenv (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
isNodePressed :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed :: forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node = forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoPressed Bool
False WidgetEnv s e
wenv (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
isNodeTreeActive :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTreeActive :: forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTreeActive WidgetEnv s e
wenv WidgetNode s e
node = forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoActive Bool
True WidgetEnv s e
wenv (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
isNodeTreePressed :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTreePressed :: forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTreePressed WidgetEnv s e
wenv WidgetNode s e
node = forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoPressed Bool
True WidgetEnv s e
wenv (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
isNodeInfoActive :: Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoActive :: forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoActive Bool
checkChildren WidgetEnv s e
wenv WidgetNodeInfo
info = Bool
validPos Bool -> Bool -> Bool
&& Bool
pressed Bool -> Bool -> Bool
&& Bool
topLevel where
viewport :: Rect
viewport = WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport
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
validPos :: Bool
validPos = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
viewport
pressed :: Bool
pressed = forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoPressed Bool
checkChildren WidgetEnv s e
wenv WidgetNodeInfo
info
topLevel :: Bool
topLevel = forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoTopLevel WidgetEnv s e
wenv WidgetNodeInfo
info
isNodeInfoPressed :: Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoPressed :: forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoPressed Bool
includeChildren WidgetEnv s e
wenv WidgetNodeInfo
info = Maybe Bool
result forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True where
path :: Path
path = WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path
pressed :: Maybe Path
pressed = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress forall s a. s -> Getting (First a) s a -> Maybe a
^? 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
result :: Maybe Bool
result
| Bool
includeChildren = forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Path
pressed
| Bool
otherwise = (Path
path forall a. Eq a => a -> a -> Bool
==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Path
pressed
isNodeDragged :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeDragged :: forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeDragged WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoDragged WidgetEnv s e
wenv (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
isNodeInfoDragged :: WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoDragged :: forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoDragged WidgetEnv s e
wenv WidgetNodeInfo
info = Bool
mainPressed Bool -> Bool -> Bool
&& Maybe Path
draggedPath forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Path
nodePath where
mainPressed :: Bool
mainPressed = forall a. Maybe a -> Bool
isJust (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress)
draggedPath :: Maybe Path
draggedPath = WidgetEnv s e
wenv forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasDragStatus s a => Lens' s a
L.dragStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
nodePath :: Path
nodePath = WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path
isNodeHovered :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered :: forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoHovered WidgetEnv s e
wenv (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
isNodeInfoHovered :: WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoHovered :: forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoHovered WidgetEnv s e
wenv WidgetNodeInfo
info = Bool
validPos Bool -> Bool -> Bool
&& Bool
validPress Bool -> Bool -> Bool
&& Bool
topLevel where
viewport :: Rect
viewport = WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport
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
validPos :: Bool
validPos = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
viewport
pressed :: Maybe Path
pressed = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress forall s a. s -> Getting (First a) s a -> Maybe a
^? 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
validPress :: Bool
validPress = forall a. Maybe a -> Bool
isNothing Maybe Path
pressed Bool -> Bool -> Bool
|| forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoPressed Bool
False WidgetEnv s e
wenv WidgetNodeInfo
info
topLevel :: Bool
topLevel = forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoTopLevel WidgetEnv s e
wenv WidgetNodeInfo
info
isNodeHoveredEllipse_ :: Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHoveredEllipse_ :: forall s e. Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHoveredEllipse_ Rect
area WidgetEnv s e
wenv WidgetNode s e
node = Bool
validPos Bool -> Bool -> Bool
&& Bool
validPress Bool -> Bool -> Bool
&& Bool
topLevel where
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
validPos :: Bool
validPos = Point -> Rect -> Bool
pointInEllipse Point
mousePos Rect
area
pressed :: Maybe Path
pressed = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress forall s a. s -> Getting (First a) s a -> Maybe a
^? 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
validPress :: Bool
validPress = forall a. Maybe a -> Bool
isNothing Maybe Path
pressed Bool -> Bool -> Bool
|| forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node
topLevel :: Bool
topLevel = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTopLevel WidgetEnv s e
wenv WidgetNode s e
node
isNodeTopLevel :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTopLevel :: forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTopLevel WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoTopLevel WidgetEnv s e
wenv (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
isNodeInfoTopLevel :: WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoTopLevel :: forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoTopLevel WidgetEnv s e
wenv WidgetNodeInfo
info = Bool
result where
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
inTopLayer :: Bool
inTopLayer = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInTopLayer s a => Lens' s a
L.inTopLayer forall a b. (a -> b) -> a -> b
$ Point
mousePos
path :: Path
path = WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path
isPrefix :: Path -> Bool
isPrefix Path
parent = forall a. PathStep -> Seq a -> Seq a
Seq.take (forall a. Seq a -> PathStep
Seq.length Path
parent) Path
path forall a. Eq a => a -> a -> Bool
== Path
parent
result :: Bool
result = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
inTopLayer Path -> Bool
isPrefix (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath)
isNodeInOverlay :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeInOverlay :: forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeInOverlay WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoInOverlay WidgetEnv s e
wenv (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
isNodeInfoInOverlay :: WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoInOverlay :: forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoInOverlay WidgetEnv s e
wenv WidgetNodeInfo
info = Bool
result where
path :: Path
path = WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path
isPrefix :: Path -> Bool
isPrefix Path
overlayPath = forall a. PathStep -> Seq a -> Seq a
Seq.take (forall a. Seq a -> PathStep
Seq.length Path
overlayPath) Path
path forall a. Eq a => a -> a -> Bool
== Path
overlayPath
result :: Bool
result = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Path -> Bool
isPrefix (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath)