content: {-|
  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 node p = pointInRect p (node ^. L.info . L.viewport)
  
  -- | Checks if the given point is inside the ellipse delimited by the viewport.
  isPointInNodeEllipse :: WidgetNode s e -> Point -> Bool
  isPointInNodeEllipse node p = pointInEllipse p (node ^. L.info . L.viewport)
  
  -- | Checks if the main button is pressed and pointer inside the viewport.
  isNodeActive :: WidgetEnv s e -> WidgetNode s e -> Bool
  isNodeActive wenv node = isNodeInfoActive False wenv (node ^. L.info)
  
  -- | Checks if the main button is pressed inside the viewport.
  isNodePressed :: WidgetEnv s e -> WidgetNode s e -> Bool
  isNodePressed wenv node = isNodeInfoPressed False wenv (node ^. L.info)
  
  -- | Checks if the node or any of its children is active.
  isNodeTreeActive :: WidgetEnv s e -> WidgetNode s e -> Bool
  isNodeTreeActive wenv node = isNodeInfoActive True wenv (node ^. L.info)
  
  -- | Checks if the node or any of its children is pressed.
  isNodeTreePressed :: WidgetEnv s e -> WidgetNode s e -> Bool
  isNodeTreePressed wenv node = isNodeInfoPressed True wenv (node ^. 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 checkChildren wenv info = validPos && pressed && topLevel where
    viewport = info ^. L.viewport
    mousePos = wenv ^. L.inputStatus . L.mousePos
    validPos = pointInRect mousePos viewport
    pressed = isNodeInfoPressed checkChildren wenv info
    topLevel = isNodeInfoTopLevel wenv 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 includeChildren wenv info = result == Just True where
    path = info ^. L.path
    pressed = wenv ^. L.mainBtnPress ^? _Just . _1
    result
      | includeChildren = seqStartsWith path <$> pressed
      | otherwise = (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 wenv node = isNodeInfoDragged wenv (node ^. L.info)
  
  -- | Checks if the nodeInfo is being dragged.
  isNodeInfoDragged :: WidgetEnv s e -> WidgetNodeInfo -> Bool
  isNodeInfoDragged wenv info = mainPressed && draggedPath == Just nodePath where
    mainPressed = isJust (wenv ^. L.mainBtnPress)
    draggedPath = wenv ^? L.dragStatus . _Just . _1
    nodePath = info ^. 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 wenv node = isNodeInfoHovered wenv (node ^. L.info)
  
  -- | Checks if nodeInfo is hovered.
  isNodeInfoHovered :: WidgetEnv s e -> WidgetNodeInfo -> Bool
  isNodeInfoHovered wenv info = validPos && validPress && topLevel where
    viewport = info ^. L.viewport
    mousePos = wenv ^. L.inputStatus . L.mousePos
    validPos = pointInRect mousePos viewport
    pressed = wenv ^. L.mainBtnPress ^? _Just . _1
    validPress = isNothing pressed || isNodeInfoPressed False wenv info
    topLevel = isNodeInfoTopLevel wenv info
  
  -- | Checks if node is hovered, limited to an elliptical shape.
  isNodeHoveredEllipse_ :: Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
  isNodeHoveredEllipse_ area wenv node = validPos && validPress && topLevel where
    mousePos = wenv ^. L.inputStatus . L.mousePos
    validPos = pointInEllipse mousePos area
    pressed = wenv ^. L.mainBtnPress ^? _Just . _1
    validPress = isNothing pressed || isNodePressed wenv node
    topLevel = isNodeTopLevel wenv 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 wenv node = isNodeInfoTopLevel wenv (node ^. L.info)
  
  -- | Checks if a nodeInfo is in a top layer.
  isNodeInfoTopLevel :: WidgetEnv s e -> WidgetNodeInfo -> Bool
  isNodeInfoTopLevel wenv info = result where
    mousePos = wenv ^. L.inputStatus . L.mousePos
    inTopLayer = wenv ^. L.inTopLayer $ mousePos
    path = info ^. L.path
    isPrefix parent = Seq.take (Seq.length parent) path == parent
    result = maybe inTopLayer isPrefix (wenv ^. L.overlayPath)
  
  -- | Checks if the node is part of the active overlay, if any.
  isNodeInOverlay :: WidgetEnv s e -> WidgetNode s e -> Bool
  isNodeInOverlay wenv node = isNodeInfoInOverlay wenv (node ^. L.info)
  
  -- | Checks if the nodeInfo is part of the active overlay, if any.
  isNodeInfoInOverlay :: WidgetEnv s e -> WidgetNodeInfo -> Bool
  isNodeInfoInOverlay wenv info = result where
    path = info ^. L.path
    isPrefix overlayPath = Seq.take (Seq.length overlayPath) path == overlayPath
    result = maybe False isPrefix (wenv ^. L.overlayPath)
  