{-|
Module      : Monomer.Widgets.Util.Hover
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 hover related actions.
-}
{-# 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

-- | Checks if the given point is inside the node's viewport.
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)

-- | Checks if the given point is inside the ellipse delimited by the 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)

-- | Checks if the main button is pressed and pointer inside the vieport.
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)

-- | Checks if the main button is pressed inside the vieport.
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)

-- | Checks if the node or any of its children is active.
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)

-- | Checks if the node or any of its children is pressed.
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)

{-|
Checks if the node is active, optionally including children. An active node was
clicked with the main button and has the pointer inside its viewport.
-}
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

{-|
Checks if the node is pressed, optionally including children. A pressed node was
clicked with the main button, but the pointer may not be inside its viewport.
-}
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

{-|
Checks if the node is being dragged. The node must have made a previous request
to be in that state.
-}
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)

-- | Checks if the nodeInfo is being dragged.
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

-- | Checks if node is hovered. Pointer must be in viewport and node top layer.
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)

-- | Checks if nodeInfo is hovered.
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

-- | Checks if node is hovered, limited to an elliptical shape.
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

{-|
Checks if a node is in a top layer. Being in zstack can cause this to be False.
-}
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)

-- | Checks if a nodeInfo is in a top layer.
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)

-- | Checks if the node is part of the active overlay, if any.
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)

-- | Checks if the nodeInfo is part of the active overlay, if any.
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)