{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Containers.Tooltip (
TooltipCfg,
tooltipDelay,
tooltipFollow,
tooltip,
tooltip_
) where
import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~))
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
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 = Maybe Millisecond
forall a. Maybe a
Nothing,
_ttcFollowCursor :: Maybe Bool
_ttcFollowCursor = Maybe Bool
forall a. Maybe a
Nothing,
_ttcMaxWidth :: Maybe Double
_ttcMaxWidth = Maybe Double
forall a. Maybe a
Nothing,
_ttcMaxHeight :: Maybe Double
_ttcMaxHeight = Maybe Double
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 Maybe Millisecond -> Maybe Millisecond -> Maybe Millisecond
forall a. Maybe a -> Maybe a -> Maybe a
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 Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
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 Maybe Double -> Maybe Double -> Maybe Double
forall a. Maybe a -> Maybe a -> Maybe a
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 Maybe Double -> Maybe Double -> Maybe Double
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TooltipCfg -> Maybe Double
_ttcMaxHeight TooltipCfg
s1
}
instance Monoid TooltipCfg where
mempty :: TooltipCfg
mempty = TooltipCfg
forall a. Default a => a
def
instance CmbMaxWidth TooltipCfg where
maxWidth :: Double -> TooltipCfg
maxWidth Double
w = TooltipCfg
forall a. Default a => a
def {
_ttcMaxWidth = Just w
}
instance CmbMaxHeight TooltipCfg where
maxHeight :: Double -> TooltipCfg
maxHeight Double
h = TooltipCfg
forall a. Default a => a
def {
_ttcMaxHeight = Just h
}
tooltipDelay :: Millisecond -> TooltipCfg
tooltipDelay :: Millisecond -> TooltipCfg
tooltipDelay Millisecond
ms = TooltipCfg
forall a. Default a => a
def {
_ttcDelay = Just ms
}
tooltipFollow :: TooltipCfg
tooltipFollow :: TooltipCfg
tooltipFollow = TooltipCfg
forall a. Default a => a
def {
_ttcFollowCursor = Just True
}
data TooltipState = TooltipState {
TooltipState -> Point
_ttsLastPos :: Point,
TooltipState -> Millisecond
_ttsLastPosTs :: Millisecond
} deriving (TooltipState -> TooltipState -> Bool
(TooltipState -> TooltipState -> Bool)
-> (TooltipState -> TooltipState -> Bool) -> Eq TooltipState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TooltipState -> TooltipState -> Bool
== :: TooltipState -> TooltipState -> Bool
$c/= :: TooltipState -> TooltipState -> Bool
/= :: TooltipState -> TooltipState -> Bool
Eq, Int -> TooltipState -> ShowS
[TooltipState] -> ShowS
TooltipState -> String
(Int -> TooltipState -> ShowS)
-> (TooltipState -> String)
-> ([TooltipState] -> ShowS)
-> Show TooltipState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TooltipState -> ShowS
showsPrec :: Int -> TooltipState -> ShowS
$cshow :: TooltipState -> String
show :: TooltipState -> String
$cshowList :: [TooltipState] -> ShowS
showList :: [TooltipState] -> ShowS
Show, (forall x. TooltipState -> Rep TooltipState x)
-> (forall x. Rep TooltipState x -> TooltipState)
-> Generic TooltipState
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
$cfrom :: forall x. TooltipState -> Rep TooltipState x
from :: forall x. TooltipState -> Rep TooltipState x
$cto :: forall x. Rep TooltipState x -> TooltipState
to :: forall x. Rep TooltipState x -> TooltipState
Generic)
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 = Text -> [TooltipCfg] -> WidgetNode s e -> WidgetNode s e
forall s e.
Text -> [TooltipCfg] -> WidgetNode s e -> WidgetNode s e
tooltip_ Text
caption [TooltipCfg]
forall a. Default a => a
def WidgetNode s e
managed
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 = Widget s e -> WidgetNode s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
forall {s} {e}. Widget s e
widget WidgetNode s e
managed where
config :: TooltipCfg
config = [TooltipCfg] -> TooltipCfg
forall a. Monoid a => [a] -> a
mconcat [TooltipCfg]
configs
state :: TooltipState
state = Point -> Millisecond -> TooltipState
TooltipState Point
forall a. Default a => a
def Millisecond
forall a. Bounded a => a
maxBound
widget :: Widget s e
widget = Text -> TooltipCfg -> TooltipState -> Widget s e
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 = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"tooltip" Widget s e
widget
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
Lens' WidgetNodeInfo Bool
L.focusable ((Bool -> Identity Bool)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNode s e -> Seq (WidgetNode s e)
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 = Widget s e
forall {s} {e}. Widget s e
widget where
baseWidget :: Widget s e
baseWidget = TooltipState -> Container s e TooltipState -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer TooltipState
state Container s e TooltipState
forall a. Default a => a
def {
containerAddStyleReq = False,
containerGetBaseStyle = getBaseStyle,
containerMerge = merge,
containerHandleEvent = handleEvent,
containerResize = resize
}
widget :: Widget s e
widget = Widget s e
forall {s} {e}. Widget s e
baseWidget {
widgetRender = render
}
delay :: Millisecond
delay = Millisecond -> Maybe Millisecond -> Millisecond
forall a. a -> Maybe a -> a
fromMaybe Millisecond
1000 (TooltipCfg -> Maybe Millisecond
_ttcDelay TooltipCfg
config)
followCursor :: Bool
followCursor = Bool -> Maybe Bool -> Bool
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 = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style where
style :: Style
style = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (StyleState -> f StyleState) -> ThemeState -> f ThemeState
forall s a. HasTooltipStyle s a => Lens' s a
Lens' ThemeState StyleState
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
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> TooltipCfg -> TooltipState -> Widget s e
forall s e. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
oldState
result :: WidgetResult s e
result = WidgetNode s e -> WidgetResult s e
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{} -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce] where
newState :: TooltipState
newState = TooltipState
state {
_ttsLastPos = Point (-1) (-1),
_ttsLastPosTs = maxBound
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> TooltipCfg -> TooltipState -> Widget s e
forall s e. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
newState
Leave Point
point -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce] where
newState :: TooltipState
newState = TooltipState
state {
_ttsLastPos = Point (-1) (-1),
_ttsLastPosTs = maxBound
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> TooltipCfg -> TooltipState -> Widget s e
forall s e. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
newState
Move Point
point
| WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
point -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
prevDisplayed :: Bool
prevDisplayed = p -> WidgetNode s e -> Bool
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,
_ttsLastPosTs = wenv ^. L.timestamp
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> TooltipCfg -> TooltipState -> Widget s e
forall s e. Text -> TooltipCfg -> TooltipState -> Widget s e
makeTooltip Text
caption TooltipCfg
config TooltipState
newState
delayedRender :: WidgetRequest s e
delayedRender = WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
delay (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
result :: WidgetResult s e
result
| Bool -> Bool
not Bool
prevDisplayed = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
delayedRender]
| Bool
prevDisplayed Bool -> Bool -> Bool
&& Bool
followCursor = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
| Bool
otherwise = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
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 = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, p -> Seq p
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
Seq (WidgetNode s e) -> (WidgetNode s e -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq (WidgetNode s e)
children ((WidgetNode s e -> IO ()) -> IO ())
-> (WidgetNode s e -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WidgetNode s e
child ->
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget) WidgetEnv s e
wenv WidgetNode s e
child Renderer
renderer
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tooltipVisible (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> IO () -> IO ()
createOverlay Renderer
renderer (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Renderer -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction Renderer
renderer Rect
rect StyleState
style ((Rect -> IO ()) -> IO ()) -> (Rect -> IO ()) -> IO ()
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
Seq TextLine -> (TextLine -> IO ()) -> IO ()
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 WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
Lens' (WidgetEnv s e) FontManager
L.fontManager
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
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 WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children
mousePos :: Point
mousePos = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Point InputStatus)
-> WidgetEnv s e -> Const Point (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
Lens' (WidgetEnv s e) InputStatus
L.inputStatus ((InputStatus -> Const Point InputStatus)
-> WidgetEnv s e -> Const Point (WidgetEnv s e))
-> ((Point -> Const Point Point)
-> InputStatus -> Const Point InputStatus)
-> Getting Point (WidgetEnv s e) Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Const Point Point)
-> InputStatus -> Const Point InputStatus
forall s a. HasMousePos s a => Lens' s a
Lens' InputStatus Point
L.mousePos
scOffset :: Point
scOffset = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point (WidgetEnv s e) Point
forall s a. HasOffset s a => Lens' s a
Lens' (WidgetEnv s e) Point
L.offset
isDragging :: Bool
isDragging = Maybe (Path, WidgetDragMsg) -> Bool
forall a. Maybe a -> Bool
isJust (WidgetEnv s e
wenv WidgetEnv s e
-> Getting
(Maybe (Path, WidgetDragMsg))
(WidgetEnv s e)
(Maybe (Path, WidgetDragMsg))
-> Maybe (Path, WidgetDragMsg)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (Path, WidgetDragMsg))
(WidgetEnv s e)
(Maybe (Path, WidgetDragMsg))
forall s a. HasDragStatus s a => Lens' s a
Lens' (WidgetEnv s e) (Maybe (Path, WidgetDragMsg))
L.dragStatus)
maxW :: Double
maxW = WidgetEnv s e
wenv WidgetEnv s e -> Getting Double (WidgetEnv s e) Double -> Double
forall s a. s -> Getting a s a -> a
^. (Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e)
forall s a. HasWindowSize s a => Lens' s a
Lens' (WidgetEnv s e) Size
L.windowSize ((Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e))
-> ((Double -> Const Double Double) -> Size -> Const Double Size)
-> Getting Double (WidgetEnv s e) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const Double Double) -> Size -> Const Double Size
forall s a. HasW s a => Lens' s a
Lens' Size Double
L.w
maxH :: Double
maxH = WidgetEnv s e
wenv WidgetEnv s e -> Getting Double (WidgetEnv s e) Double -> Double
forall s a. s -> Getting a s a -> a
^. (Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e)
forall s a. HasWindowSize s a => Lens' s a
Lens' (WidgetEnv s e) Size
L.windowSize ((Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e))
-> ((Double -> Const Double Double) -> Size -> Const Double Size)
-> Getting Double (WidgetEnv s e) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const Double Double) -> Size -> Const Double Size
forall s a. HasH s a => Lens' s a
Lens' Size Double
L.h
targetW :: Double
targetW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
maxW (TooltipCfg -> Maybe Double
_ttcMaxWidth TooltipCfg
config)
targetH :: Double
targetH = Double -> Maybe Double -> Double
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
Maybe Int
forall a. Maybe a
Nothing Size
targetSize Text
caption
textSize :: Size
textSize = Seq TextLine -> Size
getTextLinesSize Seq TextLine
fittedLines
Size Double
tw Double
th = Size -> Maybe Size -> Size
forall a. a -> Maybe a -> a
fromMaybe Size
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 WidgetEnv s e -> Getting Double (WidgetEnv s e) Double -> Double
forall s a. s -> Getting a s a -> a
^. (Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e)
forall s a. HasWindowSize s a => Lens' s a
Lens' (WidgetEnv s e) Size
L.windowSize ((Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e))
-> ((Double -> Const Double Double) -> Size -> Const Double Size)
-> Getting Double (WidgetEnv s e) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const Double Double) -> Size -> Const Double Size
forall s a. HasW s a => Lens' s a
Lens' Size Double
L.w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mx Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
tw = Double
mx
| Bool
otherwise = WidgetEnv s e
wenv WidgetEnv s e -> Getting Double (WidgetEnv s e) Double -> Double
forall s a. s -> Getting a s a -> a
^. (Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e)
forall s a. HasWindowSize s a => Lens' s a
Lens' (WidgetEnv s e) Size
L.windowSize ((Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e))
-> ((Double -> Const Double Double) -> Size -> Const Double Size)
-> Getting Double (WidgetEnv s e) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const Double Double) -> Size -> Const Double Size
forall s a. HasW s a => Lens' s a
Lens' Size Double
L.w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tw
ry :: Double
ry
| WidgetEnv s e
wenv WidgetEnv s e -> Getting Double (WidgetEnv s e) Double -> Double
forall s a. s -> Getting a s a -> a
^. (Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e)
forall s a. HasWindowSize s a => Lens' s a
Lens' (WidgetEnv s e) Size
L.windowSize ((Size -> Const Double Size)
-> WidgetEnv s e -> Const Double (WidgetEnv s e))
-> ((Double -> Const Double Double) -> Size -> Const Double Size)
-> Getting Double (WidgetEnv s e) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const Double Double) -> Size -> Const Double Size
forall s a. HasH s a => Lens' s a
Lens' Size Double
L.h Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
my Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
50) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
th = Double
my Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
20
| Bool
otherwise = Double
my Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
th Double -> Double -> Double
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 = WidgetEnv s e -> WidgetNode s e -> Bool
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 p -> Getting Millisecond p Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond p Millisecond
forall s a. HasTimestamp s a => Lens' s a
Lens' p Millisecond
L.timestamp
viewport :: Rect
viewport = p
node p -> Getting Rect p Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (a -> Const Rect a) -> p -> Const Rect p
forall s a. HasInfo s a => Lens' s a
Lens' p a
L.info ((a -> Const Rect a) -> p -> Const Rect p)
-> ((Rect -> Const Rect Rect) -> a -> Const Rect a)
-> Getting Rect p Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect) -> a -> Const Rect a
forall s a. HasViewport s a => Lens' s a
Lens' a Rect
L.viewport
inViewport :: Bool
inViewport = Point -> Rect -> Bool
pointInRect Point
lastPos Rect
viewport
delayElapsed :: Bool
delayElapsed = Millisecond
ts Millisecond -> Millisecond -> Millisecond
forall a. Num a => a -> a -> a
- Millisecond
lastPosTs Millisecond -> Millisecond -> Bool
forall a. Ord a => a -> a -> Bool
>= Millisecond
delay
displayed :: Bool
displayed = Bool
inViewport Bool -> Bool -> Bool
&& Bool
delayElapsed