{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Containers.Tooltip (
TooltipCfg,
tooltipDelay,
tooltipFollow,
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
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 :: Maybe Millisecond
-> Maybe Bool -> Maybe Double -> Maybe Double -> TooltipCfg
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 :: Maybe Millisecond
-> Maybe Bool -> Maybe Double -> Maybe Double -> TooltipCfg
TooltipCfg {
_ttcDelay :: Maybe Millisecond
_ttcDelay = TooltipCfg -> Maybe Millisecond
_ttcDelay TooltipCfg
s2 Maybe Millisecond -> Maybe Millisecond -> Maybe Millisecond
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 (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 (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 (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 :: Maybe Double
_ttcMaxWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
}
instance CmbMaxHeight TooltipCfg where
maxHeight :: Double -> TooltipCfg
maxHeight Double
h = TooltipCfg
forall a. Default a => a
def {
_ttcMaxHeight :: Maybe Double
_ttcMaxHeight = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
h
}
tooltipDelay :: Millisecond -> TooltipCfg
tooltipDelay :: Millisecond -> TooltipCfg
tooltipDelay Millisecond
ms = TooltipCfg
forall a. Default a => a
def {
_ttcDelay :: Maybe Millisecond
_ttcDelay = Millisecond -> Maybe Millisecond
forall a. a -> Maybe a
Just Millisecond
ms
}
tooltipFollow :: TooltipCfg
tooltipFollow :: TooltipCfg
tooltipFollow = TooltipCfg
forall a. Default a => a
def {
_ttcFollowCursor :: Maybe Bool
_ttcFollowCursor = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
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
/= :: TooltipState -> TooltipState -> Bool
$c/= :: TooltipState -> TooltipState -> Bool
== :: TooltipState -> TooltipState -> Bool
$c== :: 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
showList :: [TooltipState] -> ShowS
$cshowList :: [TooltipState] -> ShowS
show :: TooltipState -> String
$cshow :: TooltipState -> String
showsPrec :: Int -> TooltipState -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep TooltipState x -> TooltipState
$cfrom :: forall x. TooltipState -> Rep TooltipState x
Generic)
tooltip :: Text -> WidgetNode s e -> WidgetNode s e
tooltip :: 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_ :: 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 :: 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
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
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
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 :: 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 :: Bool
containerAddStyleReq = Bool
False,
containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = ContainerGetBaseStyle s e
forall s e p. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
containerMerge :: ContainerMergeHandler s e TooltipState
containerMerge = ContainerMergeHandler s e TooltipState
forall p s e p.
p -> WidgetNode s e -> p -> TooltipState -> WidgetResult s e
merge,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall s s e p.
HasTimestamp s Millisecond =>
s -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall p s e a p.
p -> WidgetNode s e -> a -> p -> (WidgetResult s e, Seq a)
resize
}
widget :: Widget s e
widget = Widget s e
forall s e. Widget s e
baseWidget {
widgetRender :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender = WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e. WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
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 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
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 :: s -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent s
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
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
_ttsLastPos = Double -> Double -> Point
Point (-Double
1) (-Double
1),
_ttsLastPosTs :: Millisecond
_ttsLastPosTs = Millisecond
forall a. Bounded a => a
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
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
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
L.widgetId
prevDisplayed :: Bool
prevDisplayed = s -> WidgetNode s e -> Bool
forall s a s.
(HasInfo s a, HasViewport a Rect, HasTimestamp s Millisecond) =>
s -> s -> Bool
tooltipDisplayed s
wenv WidgetNode s e
node
newState :: TooltipState
newState = TooltipState
state {
_ttsLastPos :: Point
_ttsLastPos = Point
point,
_ttsLastPosTs :: Millisecond
_ttsLastPosTs = s
wenv s -> Getting Millisecond s Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond s Millisecond
forall s a. HasTimestamp s a => Lens' s a
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
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 -> a -> p -> (WidgetResult s e, Seq a)
resize p
wenv WidgetNode s e
node a
viewport p
children = (WidgetResult s e, Seq a)
resized where
resized :: (WidgetResult s e, Seq a)
resized = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, a -> Seq a
forall a. a -> Seq a
Seq.singleton a
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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 s a s.
(HasInfo s a, HasViewport a Rect, HasTimestamp s Millisecond) =>
s -> s -> Bool
tooltipDisplayed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging
tooltipDisplayed :: s -> s -> Bool
tooltipDisplayed s
wenv s
node = Bool
displayed where
TooltipState Point
lastPos Millisecond
lastPosTs = TooltipState
state
ts :: Millisecond
ts = s
wenv s -> Getting Millisecond s Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond s Millisecond
forall s a. HasTimestamp s a => Lens' s a
L.timestamp
viewport :: Rect
viewport = s
node s -> Getting Rect s Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (a -> Const Rect a) -> s -> Const Rect s
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Rect a) -> s -> Const Rect s)
-> ((Rect -> Const Rect Rect) -> a -> Const Rect a)
-> Getting Rect s 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
L.viewport
inViewport :: Bool
inViewport = Point -> Rect -> Bool
pointInRect Point
lastPos Rect
viewport
delayEllapsed :: Bool
delayEllapsed = 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
delayEllapsed