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

Displays a text message above its child node when the pointer is on top and the
delay, if any, has ellapsed.

Tooltip styling is a bit unusual, since it is applied to the overlaid element.
This means padding will not be shown for the contained child element, but only
on the message when the tooltip is active. If padding around the child element
is needed, "Monomer.Widgets.Containers.Box" can be used to wrap it.

@
tooltip "Click the button" (buttom \"Accept\" AcceptAction)
  \`styleBasic\` [textSize 16, bgColor steelBlue, paddingH 5, radius 5]
@
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Containers.Tooltip (
  -- * Configuration
  TooltipCfg,
  tooltipDelay,
  tooltipFollow,
  -- * Constructors
  tooltip,
  tooltip_
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~), (%~), at)
import Control.Monad (forM_, when)
import Data.Default
import Data.Maybe
import Data.Text (Text)
import GHC.Generics

import qualified Data.Sequence as Seq

import Monomer.Widgets.Container

import qualified Monomer.Lens as L

{-|
Configuration options for tooltip:

- 'width': the maximum width of the tooltip. Used for multiline.
- 'height': the maximum height of the tooltip. Used for multiline.
- 'tooltipDelay': the delay in ms before the tooltip is displayed.
- 'tooltipFollow': if, after tooltip is displayed, it should follow the mouse.
-}
data TooltipCfg = TooltipCfg {
  TooltipCfg -> Maybe Millisecond
_ttcDelay :: Maybe Millisecond,
  TooltipCfg -> Maybe Bool
_ttcFollowCursor :: Maybe Bool,
  TooltipCfg -> Maybe Double
_ttcMaxWidth :: Maybe Double,
  TooltipCfg -> Maybe Double
_ttcMaxHeight :: Maybe Double
}

instance Default TooltipCfg where
  def :: TooltipCfg
def = TooltipCfg {
    _ttcDelay :: Maybe Millisecond
_ttcDelay = forall a. Maybe a
Nothing,
    _ttcFollowCursor :: Maybe Bool
_ttcFollowCursor = forall a. Maybe a
Nothing,
    _ttcMaxWidth :: Maybe Double
_ttcMaxWidth = forall a. Maybe a
Nothing,
    _ttcMaxHeight :: Maybe Double
_ttcMaxHeight = forall a. Maybe a
Nothing
  }

instance Semigroup TooltipCfg where
  <> :: TooltipCfg -> TooltipCfg -> TooltipCfg
(<>) TooltipCfg
s1 TooltipCfg
s2 = TooltipCfg {
    _ttcDelay :: Maybe Millisecond
_ttcDelay = TooltipCfg -> Maybe Millisecond
_ttcDelay TooltipCfg
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TooltipCfg -> Maybe Millisecond
_ttcDelay TooltipCfg
s1,
    _ttcFollowCursor :: Maybe Bool
_ttcFollowCursor = TooltipCfg -> Maybe Bool
_ttcFollowCursor TooltipCfg
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TooltipCfg -> Maybe Bool
_ttcFollowCursor TooltipCfg
s1,
    _ttcMaxWidth :: Maybe Double
_ttcMaxWidth = TooltipCfg -> Maybe Double
_ttcMaxWidth TooltipCfg
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TooltipCfg -> Maybe Double
_ttcMaxWidth TooltipCfg
s1,
    _ttcMaxHeight :: Maybe Double
_ttcMaxHeight = TooltipCfg -> Maybe Double
_ttcMaxHeight TooltipCfg
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TooltipCfg -> Maybe Double
_ttcMaxHeight TooltipCfg
s1
  }

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

instance CmbMaxWidth TooltipCfg where
  maxWidth :: Double -> TooltipCfg
maxWidth Double
w = forall a. Default a => a
def {
    _ttcMaxWidth :: Maybe Double
_ttcMaxWidth = forall a. a -> Maybe a
Just Double
w
  }

instance CmbMaxHeight TooltipCfg where
  maxHeight :: Double -> TooltipCfg
maxHeight Double
h = forall a. Default a => a
def {
    _ttcMaxHeight :: Maybe Double
_ttcMaxHeight = forall a. a -> Maybe a
Just Double
h
  }

-- | Delay before the tooltip is displayed when child widget is hovered.
tooltipDelay :: Millisecond -> TooltipCfg
tooltipDelay :: Millisecond -> TooltipCfg
tooltipDelay Millisecond
ms = forall a. Default a => a
def {
  _ttcDelay :: Maybe Millisecond
_ttcDelay = forall a. a -> Maybe a
Just Millisecond
ms
}

-- | Whether the tooltip should move with the mouse after being displayed.
tooltipFollow :: TooltipCfg
tooltipFollow :: TooltipCfg
tooltipFollow = forall a. Default a => a
def {
  _ttcFollowCursor :: Maybe Bool
_ttcFollowCursor = forall a. a -> Maybe a
Just Bool
True
}

data TooltipState = TooltipState {
  TooltipState -> Point
_ttsLastPos :: Point,
  TooltipState -> Millisecond
_ttsLastPosTs :: Millisecond
} deriving (TooltipState -> TooltipState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TooltipState -> TooltipState -> Bool
$c/= :: TooltipState -> TooltipState -> Bool
== :: TooltipState -> TooltipState -> Bool
$c== :: TooltipState -> TooltipState -> Bool
Eq, Int -> TooltipState -> ShowS
[TooltipState] -> ShowS
TooltipState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TooltipState] -> ShowS
$cshowList :: [TooltipState] -> ShowS
show :: TooltipState -> String
$cshow :: TooltipState -> String
showsPrec :: Int -> TooltipState -> ShowS
$cshowsPrec :: Int -> TooltipState -> ShowS
Show, forall x. Rep TooltipState x -> TooltipState
forall x. TooltipState -> Rep TooltipState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TooltipState x -> TooltipState
$cfrom :: forall x. TooltipState -> Rep TooltipState x
Generic)

-- | Creates a tooltip for the child widget.
tooltip :: Text -> WidgetNode s e -> WidgetNode s e
tooltip :: forall s e. Text -> WidgetNode s e -> WidgetNode s e
tooltip Text
caption WidgetNode s e
managed = forall s e.
Text -> [TooltipCfg] -> WidgetNode s e -> WidgetNode s e
tooltip_ Text
caption forall a. Default a => a
def WidgetNode s e
managed

-- | Creates a tooltip for the child widget. Accepts config.
tooltip_ :: Text -> [TooltipCfg] -> WidgetNode s e -> WidgetNode s e
tooltip_ :: forall s e.
Text -> [TooltipCfg] -> WidgetNode s e -> WidgetNode s e
tooltip_ Text
caption [TooltipCfg]
configs WidgetNode s e
managed = forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode forall {s} {e}. Widget s e
widget WidgetNode s e
managed where
  config :: TooltipCfg
config = forall a. Monoid a => [a] -> a
mconcat [TooltipCfg]
configs
  state :: TooltipState
state = Point -> Millisecond -> TooltipState
TooltipState forall a. Default a => a
def forall a. Bounded a => a
maxBound
  widget :: Widget s e
widget = forall s e. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
state

makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
managedWidget = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"tooltip" Widget s e
widget
  forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
  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. a -> Seq a
Seq.singleton WidgetNode s e
managedWidget

makeTooltip :: Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip :: forall s e. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
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 TooltipState
state forall a. Default a => a
def {
    containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
    containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = forall {s} {e} {p}. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
    containerMerge :: ContainerMergeHandler s e TooltipState
containerMerge = forall {p} {s} {e} {p}.
p -> WidgetNode s e -> p -> TooltipState -> WidgetResult s e
merge,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = forall {p} {s} {e} {p}.
HasTimestamp p Millisecond =>
p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    containerResize :: ContainerResizeHandler s e
containerResize = forall {p} {s} {e} {p} {p}.
p -> WidgetNode s e -> p -> p -> (WidgetResult s e, Seq p)
resize
  }
  widget :: Widget s e
widget = forall {s} {e}. Widget s e
baseWidget {
    widgetRender :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
  }

  delay :: Millisecond
delay = forall a. a -> Maybe a -> a
fromMaybe Millisecond
1000 (TooltipCfg -> Maybe Millisecond
_ttcDelay TooltipCfg
config)
  followCursor :: Bool
followCursor = forall a. a -> Maybe a -> a
fromMaybe Bool
False (TooltipCfg -> Maybe Bool
_ttcFollowCursor TooltipCfg
config)

  getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = forall a. a -> Maybe a
Just Style
style where
    style :: Style
style = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasTooltipStyle s a => Lens' s a
L.tooltipStyle

  merge :: p -> WidgetNode s e -> p -> TooltipState -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode TooltipState
oldState = WidgetResult s e
result where
    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. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
oldState
    result :: WidgetResult s e
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode

  handleEvent :: p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent p
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    ButtonAction{} -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce] where
      newState :: TooltipState
newState = TooltipState
state {
        _ttsLastPos :: Point
_ttsLastPos = Double -> Double -> Point
Point (-Double
1) (-Double
1),
        _ttsLastPosTs :: Millisecond
_ttsLastPosTs = forall a. Bounded a => a
maxBound
      }
      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. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
newState

    Leave Point
point -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
RenderOnce] where
      newState :: TooltipState
newState = TooltipState
state {
        _ttsLastPos :: Point
_ttsLastPos = Double -> Double -> Point
Point (-Double
1) (-Double
1),
        _ttsLastPosTs :: Millisecond
_ttsLastPosTs = forall a. Bounded a => a
maxBound
      }
      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. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
newState

    Move Point
point
      | forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
point -> forall a. a -> Maybe a
Just WidgetResult s e
result where
        widgetId :: WidgetId
widgetId = 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. HasWidgetId s a => Lens' s a
L.widgetId
        prevDisplayed :: Bool
prevDisplayed = forall {p} {a} {p}.
(HasInfo p a, HasViewport a Rect, HasTimestamp p Millisecond) =>
p -> p -> Bool
tooltipDisplayed p
wenv WidgetNode s e
node
        newState :: TooltipState
newState = TooltipState
state {
          _ttsLastPos :: Point
_ttsLastPos = Point
point,
          _ttsLastPosTs :: Millisecond
_ttsLastPosTs = p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
        }
        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. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
newState
        delayedRender :: WidgetRequest s e
delayedRender = forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
delay (forall a. a -> Maybe a
Just Int
1)
        result :: WidgetResult s e
result
          | Bool -> Bool
not Bool
prevDisplayed = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall s e. WidgetRequest s e
delayedRender]
          | Bool
prevDisplayed Bool -> Bool -> Bool
&& Bool
followCursor = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
RenderOnce]
          | Bool
otherwise = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

    SystemEvent
_ -> forall a. Maybe a
Nothing

  -- Padding/border is not removed. Styles are only considerer for the overlay
  resize :: p -> WidgetNode s e -> p -> p -> (WidgetResult s e, Seq p)
resize p
wenv WidgetNode s e
node p
viewport p
children = (WidgetResult s e, Seq p)
resized where
    resized :: (WidgetResult s e, Seq p)
resized = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, forall a. a -> Seq a
Seq.singleton p
viewport)

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq (WidgetNode s e)
children forall a b. (a -> b) -> a -> b
$ \WidgetNode s e
child ->
      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) WidgetEnv s e
wenv WidgetNode s e
child Renderer
renderer

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tooltipVisible forall a b. (a -> b) -> a -> b
$
      Renderer -> IO () -> IO ()
createOverlay Renderer
renderer forall a b. (a -> b) -> a -> b
$ do
        Renderer -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction Renderer
renderer Rect
rect StyleState
style forall a b. (a -> b) -> a -> b
$ \Rect
textRect -> do
          let textLines :: Seq TextLine
textLines = StyleState -> Rect -> Seq TextLine -> Seq TextLine
alignTextLines StyleState
style Rect
textRect Seq TextLine
fittedLines
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq TextLine
textLines (Renderer -> StyleState -> TextLine -> IO ()
drawTextLine Renderer
renderer StyleState
style)
    where
      fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFontManager s a => Lens' s a
L.fontManager
      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 = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
      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

      scOffset :: Point
scOffset = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOffset s a => Lens' s a
L.offset
      isDragging :: Bool
isDragging = forall a. Maybe a -> Bool
isJust (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasDragStatus s a => Lens' s a
L.dragStatus)
      maxW :: Double
maxW = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasWindowSize s a => Lens' s a
L.windowSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasW s a => Lens' s a
L.w
      maxH :: Double
maxH = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasWindowSize s a => Lens' s a
L.windowSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasH s a => Lens' s a
L.h

      targetW :: Double
targetW = forall a. a -> Maybe a -> a
fromMaybe Double
maxW (TooltipCfg -> Maybe Double
_ttcMaxWidth TooltipCfg
config)
      targetH :: Double
targetH = forall a. a -> Maybe a -> a
fromMaybe Double
maxH (TooltipCfg -> Maybe Double
_ttcMaxHeight TooltipCfg
config)
      targetSize :: Size
targetSize = Double -> Double -> Size
Size Double
targetW Double
targetH
      fittedLines :: Seq TextLine
fittedLines = FontManager
-> StyleState
-> TextOverflow
-> TextMode
-> TextTrim
-> Maybe Int
-> Size
-> Text
-> Seq TextLine
fitTextToSize FontManager
fontMgr StyleState
style TextOverflow
Ellipsis TextMode
MultiLine TextTrim
TrimSpaces
        forall a. Maybe a
Nothing Size
targetSize Text
caption
      textSize :: Size
textSize = Seq TextLine -> Size
getTextLinesSize Seq TextLine
fittedLines

      Size Double
tw Double
th = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Size -> Maybe Size
addOuterSize StyleState
style Size
textSize)
      TooltipState Point
lastPos Millisecond
_ = TooltipState
state
      Point Double
mx Double
my
        | Bool
followCursor = Point -> Point -> Point
addPoint Point
scOffset Point
mousePos
        | Bool
otherwise = Point -> Point -> Point
addPoint Point
scOffset Point
lastPos
      rx :: Double
rx
        | WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasWindowSize s a => Lens' s a
L.windowSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasW s a => Lens' s a
L.w forall a. Num a => a -> a -> a
- Double
mx forall a. Ord a => a -> a -> Bool
> Double
tw = Double
mx
        | Bool
otherwise = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasWindowSize s a => Lens' s a
L.windowSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasW s a => Lens' s a
L.w forall a. Num a => a -> a -> a
- Double
tw
      -- Add offset to have space between the tooltip and the cursor
      ry :: Double
ry
        | WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasWindowSize s a => Lens' s a
L.windowSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasH s a => Lens' s a
L.h forall a. Num a => a -> a -> a
- (Double
my forall a. Num a => a -> a -> a
+ Double
50) forall a. Ord a => a -> a -> Bool
> Double
th = Double
my forall a. Num a => a -> a -> a
+ Double
20
        | Bool
otherwise = Double
my forall a. Num a => a -> a -> a
- Double
th forall a. Num a => a -> a -> a
- Double
5
      rect :: Rect
rect = Double -> Double -> Double -> Double -> Rect
Rect Double
rx Double
ry Double
tw Double
th
      tooltipVisible :: Bool
tooltipVisible = forall {p} {a} {p}.
(HasInfo p a, HasViewport a Rect, HasTimestamp p Millisecond) =>
p -> p -> Bool
tooltipDisplayed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging

  tooltipDisplayed :: p -> p -> Bool
tooltipDisplayed p
wenv p
node = Bool
displayed where
    TooltipState Point
lastPos Millisecond
lastPosTs = TooltipState
state
    ts :: Millisecond
ts = p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
    viewport :: Rect
viewport = p
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
    inViewport :: Bool
inViewport = Point -> Rect -> Bool
pointInRect Point
lastPos Rect
viewport
    delayEllapsed :: Bool
delayEllapsed = Millisecond
ts forall a. Num a => a -> a -> a
- Millisecond
lastPosTs forall a. Ord a => a -> a -> Bool
>= Millisecond
delay
    displayed :: Bool
displayed = Bool
inViewport Bool -> Bool -> Bool
&& Bool
delayEllapsed