{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Containers.Scroll (
ScrollCfg,
ScrollMessage(..),
scrollOverlay,
scrollOverlay_,
scrollFwdStyle,
scrollFwdDefault,
scrollInvisible,
scrollInvisible_,
scrollFollowFocus,
scrollFollowFocus_,
scrollStyle,
scroll,
scroll_,
hscroll,
hscroll_,
vscroll,
vscroll_
) where
import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (.~), (^?), (^?!), (<>~), (%~), _Just, cloneLens, ix)
import Control.Monad
import Data.Default
import Data.Maybe
import Data.Typeable (cast)
import GHC.Generics
import qualified Data.Sequence as Seq
import Monomer.Helper
import Monomer.Widgets.Container
import qualified Monomer.Lens as L
data ScrollType
= ScrollH
| ScrollV
| ScrollBoth
deriving (ScrollType -> ScrollType -> Bool
(ScrollType -> ScrollType -> Bool)
-> (ScrollType -> ScrollType -> Bool) -> Eq ScrollType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollType -> ScrollType -> Bool
$c/= :: ScrollType -> ScrollType -> Bool
== :: ScrollType -> ScrollType -> Bool
$c== :: ScrollType -> ScrollType -> Bool
Eq, Int -> ScrollType -> ShowS
[ScrollType] -> ShowS
ScrollType -> String
(Int -> ScrollType -> ShowS)
-> (ScrollType -> String)
-> ([ScrollType] -> ShowS)
-> Show ScrollType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollType] -> ShowS
$cshowList :: [ScrollType] -> ShowS
show :: ScrollType -> String
$cshow :: ScrollType -> String
showsPrec :: Int -> ScrollType -> ShowS
$cshowsPrec :: Int -> ScrollType -> ShowS
Show)
data ActiveBar
= HBar
| VBar
deriving (ActiveBar -> ActiveBar -> Bool
(ActiveBar -> ActiveBar -> Bool)
-> (ActiveBar -> ActiveBar -> Bool) -> Eq ActiveBar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveBar -> ActiveBar -> Bool
$c/= :: ActiveBar -> ActiveBar -> Bool
== :: ActiveBar -> ActiveBar -> Bool
$c== :: ActiveBar -> ActiveBar -> Bool
Eq, Int -> ActiveBar -> ShowS
[ActiveBar] -> ShowS
ActiveBar -> String
(Int -> ActiveBar -> ShowS)
-> (ActiveBar -> String)
-> ([ActiveBar] -> ShowS)
-> Show ActiveBar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveBar] -> ShowS
$cshowList :: [ActiveBar] -> ShowS
show :: ActiveBar -> String
$cshow :: ActiveBar -> String
showsPrec :: Int -> ActiveBar -> ShowS
$cshowsPrec :: Int -> ActiveBar -> ShowS
Show, (forall x. ActiveBar -> Rep ActiveBar x)
-> (forall x. Rep ActiveBar x -> ActiveBar) -> Generic ActiveBar
forall x. Rep ActiveBar x -> ActiveBar
forall x. ActiveBar -> Rep ActiveBar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActiveBar x -> ActiveBar
$cfrom :: forall x. ActiveBar -> Rep ActiveBar x
Generic)
data ScrollCfg s e = ScrollCfg {
ScrollCfg s e -> Maybe ScrollType
_scScrollType :: Maybe ScrollType,
ScrollCfg s e -> Maybe Bool
_scScrollOverlay :: Maybe Bool,
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style)),
ScrollCfg s e -> Maybe Bool
_scFollowFocus :: Maybe Bool,
ScrollCfg s e -> Maybe Rational
_scWheelRate :: Maybe Rational,
ScrollCfg s e -> Maybe Color
_scBarColor :: Maybe Color,
ScrollCfg s e -> Maybe Color
_scBarHoverColor :: Maybe Color,
ScrollCfg s e -> Maybe Color
_scThumbColor :: Maybe Color,
ScrollCfg s e -> Maybe Color
_scThumbHoverColor :: Maybe Color,
ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle :: Maybe (ALens' ThemeState StyleState),
ScrollCfg s e -> Maybe Double
_scBarWidth :: Maybe Double,
ScrollCfg s e -> Maybe Double
_scThumbWidth :: Maybe Double,
ScrollCfg s e -> Maybe Double
_scThumbRadius :: Maybe Double
}
instance Default (ScrollCfg s e) where
def :: ScrollCfg s e
def = ScrollCfg :: forall s e.
Maybe ScrollType
-> Maybe Bool
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe Bool
-> Maybe Rational
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe (ALens' ThemeState StyleState)
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> ScrollCfg s e
ScrollCfg {
_scScrollType :: Maybe ScrollType
_scScrollType = Maybe ScrollType
forall a. Maybe a
Nothing,
_scScrollOverlay :: Maybe Bool
_scScrollOverlay = Maybe Bool
forall a. Maybe a
Nothing,
_scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle = Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall a. Maybe a
Nothing,
_scFollowFocus :: Maybe Bool
_scFollowFocus = Maybe Bool
forall a. Maybe a
Nothing,
_scWheelRate :: Maybe Rational
_scWheelRate = Maybe Rational
forall a. Maybe a
Nothing,
_scBarColor :: Maybe Color
_scBarColor = Maybe Color
forall a. Maybe a
Nothing,
_scBarHoverColor :: Maybe Color
_scBarHoverColor = Maybe Color
forall a. Maybe a
Nothing,
_scThumbColor :: Maybe Color
_scThumbColor = Maybe Color
forall a. Maybe a
Nothing,
_scThumbHoverColor :: Maybe Color
_scThumbHoverColor = Maybe Color
forall a. Maybe a
Nothing,
_scStyle :: Maybe (ALens' ThemeState StyleState)
_scStyle = Maybe (ALens' ThemeState StyleState)
forall a. Maybe a
Nothing,
_scBarWidth :: Maybe Double
_scBarWidth = Maybe Double
forall a. Maybe a
Nothing,
_scThumbWidth :: Maybe Double
_scThumbWidth = Maybe Double
forall a. Maybe a
Nothing,
_scThumbRadius :: Maybe Double
_scThumbRadius = Maybe Double
forall a. Maybe a
Nothing
}
instance Semigroup (ScrollCfg s e) where
<> :: ScrollCfg s e -> ScrollCfg s e -> ScrollCfg s e
(<>) ScrollCfg s e
t1 ScrollCfg s e
t2 = ScrollCfg :: forall s e.
Maybe ScrollType
-> Maybe Bool
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe Bool
-> Maybe Rational
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe (ALens' ThemeState StyleState)
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> ScrollCfg s e
ScrollCfg {
_scScrollType :: Maybe ScrollType
_scScrollType = ScrollCfg s e -> Maybe ScrollType
forall s e. ScrollCfg s e -> Maybe ScrollType
_scScrollType ScrollCfg s e
t2 Maybe ScrollType -> Maybe ScrollType -> Maybe ScrollType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe ScrollType
forall s e. ScrollCfg s e -> Maybe ScrollType
_scScrollType ScrollCfg s e
t1,
_scScrollOverlay :: Maybe Bool
_scScrollOverlay = ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay ScrollCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay ScrollCfg s e
t1,
_scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle = ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall s e.
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle ScrollCfg s e
t2 Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall s e.
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle ScrollCfg s e
t1,
_scFollowFocus :: Maybe Bool
_scFollowFocus = ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scFollowFocus ScrollCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scFollowFocus ScrollCfg s e
t1,
_scWheelRate :: Maybe Rational
_scWheelRate = ScrollCfg s e -> Maybe Rational
forall s e. ScrollCfg s e -> Maybe Rational
_scWheelRate ScrollCfg s e
t2 Maybe Rational -> Maybe Rational -> Maybe Rational
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Rational
forall s e. ScrollCfg s e -> Maybe Rational
_scWheelRate ScrollCfg s e
t1,
_scBarColor :: Maybe Color
_scBarColor = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarColor ScrollCfg s e
t2 Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarColor ScrollCfg s e
t1,
_scBarHoverColor :: Maybe Color
_scBarHoverColor = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarHoverColor ScrollCfg s e
t2 Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarHoverColor ScrollCfg s e
t1,
_scThumbColor :: Maybe Color
_scThumbColor = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbColor ScrollCfg s e
t2 Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbColor ScrollCfg s e
t1,
_scThumbHoverColor :: Maybe Color
_scThumbHoverColor = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbHoverColor ScrollCfg s e
t2 Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbHoverColor ScrollCfg s e
t1,
_scStyle :: Maybe (ALens' ThemeState StyleState)
_scStyle = ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
forall s e. ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle ScrollCfg s e
t2 Maybe (ALens' ThemeState StyleState)
-> Maybe (ALens' ThemeState StyleState)
-> Maybe (ALens' ThemeState StyleState)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
forall s e. ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle ScrollCfg s e
t1,
_scBarWidth :: Maybe Double
_scBarWidth = ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
t1,
_scThumbWidth :: Maybe Double
_scThumbWidth = ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbWidth ScrollCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbWidth ScrollCfg s e
t1,
_scThumbRadius :: Maybe Double
_scThumbRadius = ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbRadius ScrollCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbRadius ScrollCfg s e
t1
}
instance Monoid (ScrollCfg s e) where
mempty :: ScrollCfg s e
mempty = ScrollCfg s e
forall a. Default a => a
def
instance CmbWheelRate (ScrollCfg s e) Rational where
wheelRate :: Rational -> ScrollCfg s e
wheelRate Rational
rate = ScrollCfg s e
forall a. Default a => a
def {
_scWheelRate :: Maybe Rational
_scWheelRate = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
rate
}
instance CmbBarColor (ScrollCfg s e) where
barColor :: Color -> ScrollCfg s e
barColor Color
col = ScrollCfg s e
forall a. Default a => a
def {
_scBarColor :: Maybe Color
_scBarColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col
}
instance CmbBarHoverColor (ScrollCfg s e) where
barHoverColor :: Color -> ScrollCfg s e
barHoverColor Color
col = ScrollCfg s e
forall a. Default a => a
def {
_scBarHoverColor :: Maybe Color
_scBarHoverColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col
}
instance CmbBarWidth (ScrollCfg s e) where
barWidth :: Double -> ScrollCfg s e
barWidth Double
w = ScrollCfg s e
forall a. Default a => a
def {
_scBarWidth :: Maybe Double
_scBarWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
}
instance CmbThumbColor (ScrollCfg s e) where
thumbColor :: Color -> ScrollCfg s e
thumbColor Color
col = ScrollCfg s e
forall a. Default a => a
def {
_scThumbColor :: Maybe Color
_scThumbColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col
}
instance CmbThumbHoverColor (ScrollCfg s e) where
thumbHoverColor :: Color -> ScrollCfg s e
thumbHoverColor Color
col = ScrollCfg s e
forall a. Default a => a
def {
_scThumbHoverColor :: Maybe Color
_scThumbHoverColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col
}
instance CmbThumbWidth (ScrollCfg s e) where
thumbWidth :: Double -> ScrollCfg s e
thumbWidth Double
w = ScrollCfg s e
forall a. Default a => a
def {
_scThumbWidth :: Maybe Double
_scThumbWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
}
instance CmbThumbRadius (ScrollCfg s e) where
thumbRadius :: Double -> ScrollCfg s e
thumbRadius Double
r = ScrollCfg s e
forall a. Default a => a
def {
_scThumbRadius :: Maybe Double
_scThumbRadius = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
r
}
scrollOverlay :: ScrollCfg s e
scrollOverlay :: ScrollCfg s e
scrollOverlay = Bool -> ScrollCfg s e
forall s e. Bool -> ScrollCfg s e
scrollOverlay_ Bool
True
scrollOverlay_ :: Bool -> ScrollCfg s e
scrollOverlay_ :: Bool -> ScrollCfg s e
scrollOverlay_ Bool
overlay = ScrollCfg s e
forall a. Default a => a
def {
_scScrollOverlay :: Maybe Bool
_scScrollOverlay = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
overlay
}
scrollFwdStyle :: (WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
scrollFwdStyle :: (WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
scrollFwdStyle WidgetEnv s e -> Style -> (Style, Style)
fwd = ScrollCfg Any Any
forall a. Default a => a
def {
_scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle = (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall a. a -> Maybe a
Just WidgetEnv s e -> Style -> (Style, Style)
fwd
}
scrollFwdDefault :: WidgetEnv s e -> Style -> (Style, Style)
scrollFwdDefault :: WidgetEnv s e -> Style -> (Style, Style)
scrollFwdDefault WidgetEnv s e
wenv Style
style = (Style
scrollStyle, Style
childStyle) where
scrollStyle :: Style
scrollStyle = Style
forall a. Default a => a
def
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe SizeReq) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSizeReqW s a => Lens' s a
Lens' StyleState (Maybe SizeReq)
L.sizeReqW Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe SizeReq) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSizeReqH s a => Lens' s a
Lens' StyleState (Maybe SizeReq)
L.sizeReqH Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Border) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasBorder s a => Lens' s a
Lens' StyleState (Maybe Border)
L.border Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Radius) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasRadius s a => Lens' s a
Lens' StyleState (Maybe Radius)
L.radius Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Color) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasBgColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.bgColor Style
style
childStyle :: Style
childStyle = Style
forall a. Default a => a
def
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Padding) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasPadding s a => Lens' s a
Lens' StyleState (Maybe Padding)
L.padding Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Color) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasFgColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.fgColor Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Color) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSndColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.sndColor Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Color) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasHlColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.hlColor Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe TextStyle) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasText s a => Lens' s a
Lens' StyleState (Maybe TextStyle)
L.text Style
style
Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe CursorIcon) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasCursorIcon s a => Lens' s a
Lens' StyleState (Maybe CursorIcon)
L.cursorIcon Style
style
scrollInvisible :: ScrollCfg s e
scrollInvisible :: ScrollCfg s e
scrollInvisible = Bool -> ScrollCfg s e
forall s e. Bool -> ScrollCfg s e
scrollInvisible_ Bool
True
scrollInvisible_ :: Bool -> ScrollCfg s e
scrollInvisible_ :: Bool -> ScrollCfg s e
scrollInvisible_ Bool
False = ScrollCfg s e
forall a. Default a => a
def
scrollInvisible_ Bool
True = ScrollCfg s e
forall a. Default a => a
def {
_scScrollOverlay :: Maybe Bool
_scScrollOverlay = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
_scBarColor :: Maybe Color
_scBarColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
transparent,
_scBarHoverColor :: Maybe Color
_scBarHoverColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
transparent,
_scThumbColor :: Maybe Color
_scThumbColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
transparent,
_scThumbHoverColor :: Maybe Color
_scThumbHoverColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
transparent
}
scrollFollowFocus :: ScrollCfg s e
scrollFollowFocus :: ScrollCfg s e
scrollFollowFocus = Bool -> ScrollCfg s e
forall s e. Bool -> ScrollCfg s e
scrollFollowFocus_ Bool
True
scrollFollowFocus_ :: Bool -> ScrollCfg s e
scrollFollowFocus_ :: Bool -> ScrollCfg s e
scrollFollowFocus_ Bool
follow = ScrollCfg s e
forall a. Default a => a
def {
_scFollowFocus :: Maybe Bool
_scFollowFocus = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
follow
}
scrollStyle :: ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle :: ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle ALens' ThemeState StyleState
style = ScrollCfg s e
forall a. Default a => a
def {
_scStyle :: Maybe (ALens' ThemeState StyleState)
_scStyle = ALens' ThemeState StyleState
-> Maybe (ALens' ThemeState StyleState)
forall a. a -> Maybe a
Just ALens' ThemeState StyleState
style
}
scrollType :: ScrollType -> ScrollCfg s e
scrollType :: ScrollType -> ScrollCfg s e
scrollType ScrollType
st = ScrollCfg s e
forall a. Default a => a
def {
_scScrollType :: Maybe ScrollType
_scScrollType = ScrollType -> Maybe ScrollType
forall a. a -> Maybe a
Just ScrollType
st
}
data ScrollState = ScrollState {
ScrollState -> Maybe ActiveBar
_sstDragging :: Maybe ActiveBar,
ScrollState -> Double
_sstDeltaX :: !Double,
ScrollState -> Double
_sstDeltaY :: !Double,
ScrollState -> Size
_sstVpSize :: Size,
ScrollState -> Size
_sstChildSize :: Size,
ScrollState -> Rect
_sstScissor :: Rect
} deriving (ScrollState -> ScrollState -> Bool
(ScrollState -> ScrollState -> Bool)
-> (ScrollState -> ScrollState -> Bool) -> Eq ScrollState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollState -> ScrollState -> Bool
$c/= :: ScrollState -> ScrollState -> Bool
== :: ScrollState -> ScrollState -> Bool
$c== :: ScrollState -> ScrollState -> Bool
Eq, Int -> ScrollState -> ShowS
[ScrollState] -> ShowS
ScrollState -> String
(Int -> ScrollState -> ShowS)
-> (ScrollState -> String)
-> ([ScrollState] -> ShowS)
-> Show ScrollState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollState] -> ShowS
$cshowList :: [ScrollState] -> ShowS
show :: ScrollState -> String
$cshow :: ScrollState -> String
showsPrec :: Int -> ScrollState -> ShowS
$cshowsPrec :: Int -> ScrollState -> ShowS
Show, (forall x. ScrollState -> Rep ScrollState x)
-> (forall x. Rep ScrollState x -> ScrollState)
-> Generic ScrollState
forall x. Rep ScrollState x -> ScrollState
forall x. ScrollState -> Rep ScrollState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScrollState x -> ScrollState
$cfrom :: forall x. ScrollState -> Rep ScrollState x
Generic)
data ScrollContext = ScrollContext {
ScrollContext -> Double
hScrollRatio :: Double,
ScrollContext -> Double
vScrollRatio :: Double,
ScrollContext -> Bool
hScrollRequired :: Bool,
ScrollContext -> Bool
vScrollRequired :: Bool,
ScrollContext -> Bool
hMouseInScroll :: Bool,
ScrollContext -> Bool
vMouseInScroll :: Bool,
ScrollContext -> Bool
hMouseInThumb :: Bool,
ScrollContext -> Bool
vMouseInThumb :: Bool,
ScrollContext -> Rect
hScrollRect :: Rect,
ScrollContext -> Rect
vScrollRect :: Rect,
ScrollContext -> Rect
hThumbRect :: Rect,
ScrollContext -> Rect
vThumbRect :: Rect
} deriving (ScrollContext -> ScrollContext -> Bool
(ScrollContext -> ScrollContext -> Bool)
-> (ScrollContext -> ScrollContext -> Bool) -> Eq ScrollContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollContext -> ScrollContext -> Bool
$c/= :: ScrollContext -> ScrollContext -> Bool
== :: ScrollContext -> ScrollContext -> Bool
$c== :: ScrollContext -> ScrollContext -> Bool
Eq, Int -> ScrollContext -> ShowS
[ScrollContext] -> ShowS
ScrollContext -> String
(Int -> ScrollContext -> ShowS)
-> (ScrollContext -> String)
-> ([ScrollContext] -> ShowS)
-> Show ScrollContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollContext] -> ShowS
$cshowList :: [ScrollContext] -> ShowS
show :: ScrollContext -> String
$cshow :: ScrollContext -> String
showsPrec :: Int -> ScrollContext -> ShowS
$cshowsPrec :: Int -> ScrollContext -> ShowS
Show)
instance Default ScrollState where
def :: ScrollState
def = ScrollState :: Maybe ActiveBar
-> Double -> Double -> Size -> Size -> Rect -> ScrollState
ScrollState {
_sstDragging :: Maybe ActiveBar
_sstDragging = Maybe ActiveBar
forall a. Maybe a
Nothing,
_sstDeltaX :: Double
_sstDeltaX = Double
0,
_sstDeltaY :: Double
_sstDeltaY = Double
0,
_sstVpSize :: Size
_sstVpSize = Size
forall a. Default a => a
def,
_sstChildSize :: Size
_sstChildSize = Size
forall a. Default a => a
def,
_sstScissor :: Rect
_sstScissor = Rect
forall a. Default a => a
def
}
data ScrollMessage
= ScrollTo Rect
| ScrollReset
deriving (ScrollMessage -> ScrollMessage -> Bool
(ScrollMessage -> ScrollMessage -> Bool)
-> (ScrollMessage -> ScrollMessage -> Bool) -> Eq ScrollMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollMessage -> ScrollMessage -> Bool
$c/= :: ScrollMessage -> ScrollMessage -> Bool
== :: ScrollMessage -> ScrollMessage -> Bool
$c== :: ScrollMessage -> ScrollMessage -> Bool
Eq, Int -> ScrollMessage -> ShowS
[ScrollMessage] -> ShowS
ScrollMessage -> String
(Int -> ScrollMessage -> ShowS)
-> (ScrollMessage -> String)
-> ([ScrollMessage] -> ShowS)
-> Show ScrollMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollMessage] -> ShowS
$cshowList :: [ScrollMessage] -> ShowS
show :: ScrollMessage -> String
$cshow :: ScrollMessage -> String
showsPrec :: Int -> ScrollMessage -> ShowS
$cshowsPrec :: Int -> ScrollMessage -> ShowS
Show)
scroll :: WidgetNode s e -> WidgetNode s e
scroll :: WidgetNode s e -> WidgetNode s e
scroll WidgetNode s e
managedWidget = [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [ScrollCfg s e]
forall a. Default a => a
def WidgetNode s e
managedWidget
scroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [ScrollCfg s e]
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 (ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
forall a. Default a => a
def) WidgetNode s e
managed where
config :: ScrollCfg s e
config = [ScrollCfg s e] -> ScrollCfg s e
forall a. Monoid a => [a] -> a
mconcat [ScrollCfg s e]
configs
hscroll :: WidgetNode s e -> WidgetNode s e
hscroll :: WidgetNode s e -> WidgetNode s e
hscroll WidgetNode s e
managedWidget = [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
hscroll_ [ScrollCfg s e]
forall a. Default a => a
def WidgetNode s e
managedWidget
hscroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
hscroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
hscroll_ [ScrollCfg s e]
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 (ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
forall a. Default a => a
def) WidgetNode s e
managed where
config :: ScrollCfg s e
config = [ScrollCfg s e] -> ScrollCfg s e
forall a. Monoid a => [a] -> a
mconcat (ScrollType -> ScrollCfg s e
forall s e. ScrollType -> ScrollCfg s e
scrollType ScrollType
ScrollH ScrollCfg s e -> [ScrollCfg s e] -> [ScrollCfg s e]
forall a. a -> [a] -> [a]
: [ScrollCfg s e]
configs)
vscroll :: WidgetNode s e -> WidgetNode s e
vscroll :: WidgetNode s e -> WidgetNode s e
vscroll WidgetNode s e
managedWidget = [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
vscroll_ [ScrollCfg s e]
forall a. Default a => a
def WidgetNode s e
managedWidget
vscroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
vscroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
vscroll_ [ScrollCfg s e]
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 (ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
forall a. Default a => a
def) WidgetNode s e
managed where
config :: ScrollCfg s e
config = [ScrollCfg s e] -> ScrollCfg s e
forall a. Monoid a => [a] -> a
mconcat (ScrollType -> ScrollCfg s e
forall s e. ScrollType -> ScrollCfg s e
scrollType ScrollType
ScrollV ScrollCfg s e -> [ScrollCfg s e] -> [ScrollCfg s e]
forall a. a -> [a] -> [a]
: [ScrollCfg s e]
configs)
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
"scroll" 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
makeScroll :: ScrollCfg s e -> ScrollState -> Widget s e
makeScroll :: ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
state = Widget s e
widget where
widget :: Widget s e
widget = ScrollState -> Container s e ScrollState -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer ScrollState
state Container s e ScrollState
forall a. Default a => a
def {
containerChildrenOffset :: Maybe Point
containerChildrenOffset = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
offset,
containerChildrenScissor :: Maybe Rect
containerChildrenScissor = Rect -> Maybe Rect
forall a. a -> Maybe a
Just (ScrollState -> Rect
_sstScissor ScrollState
state),
containerLayoutDirection :: LayoutDirection
containerLayoutDirection = LayoutDirection
layoutDirection,
containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = ContainerGetBaseStyle s e
forall s e p. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle,
containerUpdateCWenv :: ContainerUpdateCWenvHandler s e
containerUpdateCWenv = ContainerUpdateCWenvHandler s e
forall p p.
WidgetEnv s e -> WidgetNode s e -> p -> p -> WidgetEnv s e
updateCWenv,
containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init,
containerMerge :: ContainerMergeHandler s e ScrollState
containerMerge = ContainerMergeHandler s e ScrollState
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> ScrollState -> WidgetResult s e
merge,
containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = ContainerFindByPointHandler s e
forall a p.
Num a =>
WidgetEnv s e -> WidgetNode s e -> p -> Point -> Maybe a
findByPoint,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = ContainerMessageHandler s e
forall a p.
Typeable a =>
WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage,
containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize,
containerRenderAfter :: ContainerRenderHandler s e
containerRenderAfter = ContainerRenderHandler s e
renderAfter
}
ScrollState Maybe ActiveBar
dragging Double
dx Double
dy Size
_ Size
_ Rect
_ = ScrollState
state
Size Double
childWidth Double
childHeight = ScrollState -> Size
_sstChildSize ScrollState
state
Size Double
maxVpW Double
maxVpH = ScrollState -> Size
_sstVpSize ScrollState
state
offset :: Point
offset = Double -> Double -> Point
Point Double
dx Double
dy
scrollType :: ScrollType
scrollType = ScrollType -> Maybe ScrollType -> ScrollType
forall a. a -> Maybe a -> a
fromMaybe ScrollType
ScrollBoth (ScrollCfg s e -> Maybe ScrollType
forall s e. ScrollCfg s e -> Maybe ScrollType
_scScrollType ScrollCfg s e
config)
layoutDirection :: LayoutDirection
layoutDirection = case ScrollType
scrollType of
ScrollType
ScrollH -> LayoutDirection
LayoutHorizontal
ScrollType
ScrollV -> LayoutDirection
LayoutVertical
ScrollType
ScrollBoth -> LayoutDirection
LayoutNone
getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
forall s e. ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle ScrollCfg s e
config Maybe (ALens' ThemeState StyleState)
-> (ALens' ThemeState StyleState -> Maybe Style) -> Maybe Style
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ALens' ThemeState StyleState -> Maybe Style
handler where
handler :: ALens' ThemeState StyleState -> Maybe Style
handler ALens' ThemeState StyleState
lstyle = Style -> Maybe Style
forall a. a -> Maybe a
Just (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (ALens' ThemeState StyleState -> Lens' ThemeState StyleState
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' ThemeState StyleState
lstyle)
checkFwdStyle :: WidgetEnv s e -> p -> p
checkFwdStyle WidgetEnv s e
wenv p
node = p
newNode where
fwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle = ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall s e.
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle ScrollCfg s e
config
style :: Style
style = p
node p -> Getting Style p Style -> Style
forall s a. s -> Getting a s a -> a
^. (a -> Const Style a) -> p -> Const Style p
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Style a) -> p -> Const Style p)
-> ((Style -> Const Style Style) -> a -> Const Style a)
-> Getting Style p Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Const Style Style) -> a -> Const Style a
forall s a. HasStyle s a => Lens' s a
L.style
(Style
parentStyle, Style
childStyle)
| Maybe (WidgetEnv s e -> Style -> (Style, Style)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle = Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> WidgetEnv s e -> Style -> (Style, Style)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle WidgetEnv s e
wenv Style
style
| Bool
otherwise = (Style, Style)
forall a. Default a => a
def
newNode :: p
newNode
| Maybe (WidgetEnv s e -> Style -> (Style, Style)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle = p
node
p -> (p -> p) -> p
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> p -> Identity p
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Identity a) -> p -> Identity p)
-> ((Style -> Identity Style) -> a -> Identity a)
-> (Style -> Identity Style)
-> p
-> Identity p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style) -> a -> Identity a
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style) -> p -> Identity p) -> Style -> p -> p
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
parentStyle
p -> (p -> p) -> p
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> p -> Identity p
forall s a. HasChildren s a => Lens' s a
L.children ((a -> Identity a) -> p -> Identity p)
-> ((Style -> Identity Style) -> a -> Identity a)
-> (Style -> Identity Style)
-> p
-> Identity p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index a -> Traversal' a (IxValue a)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index a
0 ((IxValue a -> Identity (IxValue a)) -> a -> Identity a)
-> ((Style -> Identity Style) -> IxValue a -> Identity (IxValue a))
-> (Style -> Identity Style)
-> a
-> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity a) -> IxValue a -> Identity (IxValue a)
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Identity a) -> IxValue a -> Identity (IxValue a))
-> ((Style -> Identity Style) -> a -> Identity a)
-> (Style -> Identity Style)
-> IxValue a
-> Identity (IxValue a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style) -> a -> Identity a
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style) -> p -> Identity p) -> Style -> p -> p
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
childStyle
| Bool
otherwise = p
node
updateCWenv :: WidgetEnv s e -> WidgetNode s e -> p -> p -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node p
cnode p
cidx = WidgetEnv s e
newWenv where
theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
barW :: Double
barW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollBarWidth s a => Lens' s a
L.scrollBarWidth) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
config)
overlay :: Bool
overlay = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Bool ThemeState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool ThemeState Bool
forall s a. HasScrollOverlay s a => Lens' s a
L.scrollOverlay) (ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay ScrollCfg s e
config)
ScrollContext{Bool
Double
Rect
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRequired :: Bool
hScrollRequired :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
vThumbRect :: ScrollContext -> Rect
hThumbRect :: ScrollContext -> Rect
vScrollRect :: ScrollContext -> Rect
hScrollRect :: ScrollContext -> Rect
vMouseInThumb :: ScrollContext -> Bool
hMouseInThumb :: ScrollContext -> Bool
vMouseInScroll :: ScrollContext -> Bool
hMouseInScroll :: ScrollContext -> Bool
vScrollRequired :: ScrollContext -> Bool
hScrollRequired :: ScrollContext -> Bool
vScrollRatio :: ScrollContext -> Double
hScrollRatio :: ScrollContext -> Double
..} = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state (Double -> Double -> Point
Point Double
0 Double
0)
style :: StyleState
style = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
carea :: Rect
carea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
barH :: Double
barH
| Bool
hScrollRequired Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
overlay = Double
barW
| Bool
otherwise = Double
0
barV :: Double
barV
| Bool
vScrollRequired Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
overlay = Double
barW
| Bool
otherwise = Double
0
clientArea :: Maybe Rect
clientArea = Rect -> Double -> Double -> Double -> Double -> Maybe Rect
subtractFromRect Rect
carea Double
0 Double
barV Double
0 Double
barH
newWenv :: WidgetEnv s e
newWenv = WidgetEnv s e
wenv
WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e))
-> Rect -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point -> Rect -> Rect
moveRect (Point -> Point
negPoint Point
offset) (Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
carea Maybe Rect
clientArea)
init :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall p a a a a.
(HasInfo p a, HasStyle a Style, HasChildren p a, Ixed a,
Num (Index a), HasInfo p a, HasInfo (IxValue a) a,
HasStyle a Style, HasStyle a Style) =>
WidgetEnv s e -> p -> p
checkFwdStyle WidgetEnv s e
wenv WidgetNode s e
node
merge :: WidgetEnv s e
-> WidgetNode s e -> p -> ScrollState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
node p
oldNode ScrollState
oldState = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall p a a a a.
(HasInfo p a, HasStyle a Style, HasChildren p a, Ixed a,
Num (Index a), HasInfo p a, HasInfo (IxValue a) a,
HasStyle a Style, HasStyle a Style) =>
WidgetEnv s e -> p -> p
checkFwdStyle WidgetEnv s e
wenv (WidgetNode s e -> WidgetNode s e)
-> WidgetNode s e -> WidgetNode s e
forall a b. (a -> b) -> a -> b
$ 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
.~ ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
oldState
findByPoint :: WidgetEnv s e -> WidgetNode s e -> p -> Point -> Maybe a
findByPoint WidgetEnv s e
wenv WidgetNode s e
node p
start Point
point = Maybe a
result where
scrollPoint :: Point
scrollPoint = Point -> Point -> Point
subPoint Point
point Point
offset
sctx :: ScrollContext
sctx = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
scrollPoint
mouseInScroll :: Bool
mouseInScroll
= (ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
&& ScrollContext -> Bool
hScrollRequired ScrollContext
sctx)
Bool -> Bool -> Bool
|| (ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
&& ScrollContext -> Bool
vScrollRequired ScrollContext
sctx)
child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (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) Int
0
childHovered :: Bool
childHovered = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
child Point
point
childDragged :: Bool
childDragged = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
child
result :: Maybe a
result
| (Bool -> Bool
not Bool
mouseInScroll Bool -> Bool -> Bool
&& Bool
childHovered) Bool -> Bool -> Bool
|| Bool
childDragged = a -> Maybe a
forall a. a -> Maybe a
Just a
0
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
Focus{} -> Maybe (WidgetResult s e)
result where
overlay :: Maybe (Seq Int)
overlay = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (Maybe (Seq Int)) (WidgetEnv s e) (Maybe (Seq Int))
-> Maybe (Seq Int)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Seq Int)) (WidgetEnv s e) (Maybe (Seq Int))
forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath
inOverlay :: s -> Bool
inOverlay s
info
| Maybe (Seq Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Seq Int)
overlay = Seq Int -> Seq Int -> Bool
forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith (Maybe (Seq Int) -> Seq Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Int)
overlay) (s
info s -> Getting (Seq Int) s (Seq Int) -> Seq Int
forall s a. s -> Getting a s a -> a
^. Getting (Seq Int) s (Seq Int)
forall s a. HasPath s a => Lens' s a
L.path)
| Bool
otherwise = Bool
False
focusPath :: Seq Int
focusPath = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (Seq Int) (WidgetEnv s e) (Seq Int) -> Seq Int
forall s a. s -> Getting a s a -> a
^. Getting (Seq Int) (WidgetEnv s e) (Seq Int)
forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath
focusInst :: Maybe WidgetNodeInfo
focusInst = WidgetEnv s e -> WidgetNode s e -> Seq Int -> Maybe WidgetNodeInfo
forall s e.
WidgetEnv s e -> WidgetNode s e -> Seq Int -> Maybe WidgetNodeInfo
findInstOrScroll WidgetEnv s e
wenv WidgetNode s e
node Seq Int
focusPath
focusVp :: Maybe Rect
focusVp = Maybe WidgetNodeInfo
focusInst Maybe WidgetNodeInfo
-> Getting (First Rect) (Maybe WidgetNodeInfo) Rect -> Maybe Rect
forall s a. s -> Getting (First a) s a -> Maybe a
^? (WidgetNodeInfo -> Const (First Rect) WidgetNodeInfo)
-> Maybe WidgetNodeInfo
-> Const (First Rect) (Maybe WidgetNodeInfo)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((WidgetNodeInfo -> Const (First Rect) WidgetNodeInfo)
-> Maybe WidgetNodeInfo
-> Const (First Rect) (Maybe WidgetNodeInfo))
-> ((Rect -> Const (First Rect) Rect)
-> WidgetNodeInfo -> Const (First Rect) WidgetNodeInfo)
-> Getting (First Rect) (Maybe WidgetNodeInfo) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const (First Rect) Rect)
-> WidgetNodeInfo -> Const (First Rect) WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
focusOverlay :: Bool
focusOverlay = Bool -> (WidgetNodeInfo -> Bool) -> Maybe WidgetNodeInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False WidgetNodeInfo -> Bool
forall s. HasPath s (Seq Int) => s -> Bool
inOverlay Maybe WidgetNodeInfo
focusInst
follow :: Bool
follow = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Bool ThemeState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool ThemeState Bool
forall s a. HasScrollFollowFocus s a => Lens' s a
L.scrollFollowFocus) (ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scFollowFocus ScrollCfg s e
config)
overlayMatch :: Bool
overlayMatch = Bool
focusOverlay Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetNodeInfo -> Bool
forall s. HasPath s (Seq Int) => s -> Bool
inOverlay (WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info)
result :: Maybe (WidgetResult s e)
result
| Bool
follow Bool -> Bool -> Bool
&& Bool
overlayMatch = Maybe Rect
focusVp Maybe Rect
-> (Rect -> Maybe (WidgetResult s e)) -> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WidgetEnv s e -> WidgetNode s e -> Rect -> Maybe (WidgetResult s e)
scrollTo WidgetEnv s e
wenv WidgetNode s e
node
| Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
ButtonAction Point
point Button
btn ButtonState
status Int
_ -> Maybe (WidgetResult s e)
result where
mainPressed :: Bool
mainPressed = ButtonState
status ButtonState -> ButtonState -> Bool
forall a. Eq a => a -> a -> Bool
== ButtonState
BtnPressed Bool -> Bool -> Bool
&& Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
L.mainButton
mainReleased :: Bool
mainReleased = ButtonState
status ButtonState -> ButtonState -> Bool
forall a. Eq a => a -> a -> Bool
== ButtonState
BtnReleased Bool -> Bool -> Bool
&& Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
L.mainButton
isDragging :: Bool
isDragging = Maybe ActiveBar -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ActiveBar -> Bool) -> Maybe ActiveBar -> Bool
forall a b. (a -> b) -> a -> b
$ ScrollState -> Maybe ActiveBar
_sstDragging ScrollState
state
startDragH :: Bool
startDragH = Bool
mainPressed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging Bool -> Bool -> Bool
&& ScrollContext -> Bool
hMouseInThumb ScrollContext
sctx
startDragV :: Bool
startDragV = Bool
mainPressed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging Bool -> Bool -> Bool
&& ScrollContext -> Bool
vMouseInThumb ScrollContext
sctx
jumpScrollH :: Bool
jumpScrollH = Bool
mainPressed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging Bool -> Bool -> Bool
&& ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx
jumpScrollV :: Bool
jumpScrollV = Bool
mainPressed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging Bool -> Bool -> Bool
&& ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx
mouseInThumb :: Bool
mouseInThumb = ScrollContext -> Bool
hMouseInThumb ScrollContext
sctx Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInThumb ScrollContext
sctx
mouseInScroll :: Bool
mouseInScroll = ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx
newState :: ScrollState
newState
| Bool
startDragH = ScrollState
state { _sstDragging :: Maybe ActiveBar
_sstDragging = ActiveBar -> Maybe ActiveBar
forall a. a -> Maybe a
Just ActiveBar
HBar }
| Bool
startDragV = ScrollState
state { _sstDragging :: Maybe ActiveBar
_sstDragging = ActiveBar -> Maybe ActiveBar
forall a. a -> Maybe a
Just ActiveBar
VBar }
| Bool
jumpScrollH = ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
HBar Point
point Rect
contentArea ScrollContext
sctx
| Bool
jumpScrollV = ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
VBar Point
point Rect
contentArea ScrollContext
sctx
| Bool
mainReleased = ScrollState
state { _sstDragging :: Maybe ActiveBar
_sstDragging = Maybe ActiveBar
forall a. Maybe a
Nothing }
| Bool
otherwise = ScrollState
state
newRes :: WidgetResult s e
newRes = WidgetEnv s e -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget WidgetEnv s e
wenv WidgetNode s e
node ScrollState
newState
handledResult :: Maybe (WidgetResult s e)
handledResult = 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
$ WidgetResult s e
newRes
WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollReqs
result :: Maybe (WidgetResult s e)
result
| Bool
mainPressed Bool -> Bool -> Bool
&& (Bool
mouseInThumb Bool -> Bool -> Bool
|| Bool
mouseInScroll) = Maybe (WidgetResult s e)
handledResult
| Bool
mainReleased Bool -> Bool -> Bool
&& Bool
isDragging = Maybe (WidgetResult s e)
handledResult
| Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
Move Point
point | Maybe ActiveBar -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActiveBar
dragging -> Maybe (WidgetResult s e)
result where
drag :: ActiveBar -> ScrollState
drag ActiveBar
bar = ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
bar Point
point Rect
contentArea ScrollContext
sctx
makeWidget :: ScrollState -> WidgetResult s e
makeWidget ScrollState
state = WidgetEnv s e -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state
makeResult :: ScrollState -> WidgetResult s e
makeResult ScrollState
state = ScrollState -> WidgetResult s e
makeWidget ScrollState
state
WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList (WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce WidgetRequest s e -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. a -> [a] -> [a]
: [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollReqs)
result :: Maybe (WidgetResult s e)
result = (ActiveBar -> WidgetResult s e)
-> Maybe ActiveBar -> Maybe (WidgetResult s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScrollState -> WidgetResult s e
makeResult (ScrollState -> WidgetResult s e)
-> (ActiveBar -> ScrollState) -> ActiveBar -> WidgetResult s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveBar -> ScrollState
drag) Maybe ActiveBar
dragging
Move Point
point | Maybe ActiveBar -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ActiveBar
dragging -> Maybe (WidgetResult s e)
result where
mousePosPrev :: Point
mousePosPrev = 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. HasMousePosPrev s a => Lens' s a
L.mousePosPrev
psctx :: ScrollContext
psctx = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
mousePosPrev
changed :: Bool
changed
= ScrollContext -> Bool
hMouseInThumb ScrollContext
sctx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
hMouseInThumb ScrollContext
psctx
Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInThumb ScrollContext
sctx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
vMouseInThumb ScrollContext
psctx
Bool -> Bool -> Bool
|| ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
hMouseInScroll ScrollContext
psctx
Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
vMouseInScroll ScrollContext
psctx
result :: Maybe (WidgetResult s e)
result
| Bool
changed = 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
node [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
| Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
WheelScroll Point
_ (Point Double
wx Double
wy) WheelDirection
wheelDirection -> Maybe (WidgetResult s e)
result where
changedX :: Bool
changedX = Double
wx Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0 Bool -> Bool -> Bool
&& Double
childWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cw
changedY :: Bool
changedY = Double
wy Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0 Bool -> Bool -> Bool
&& Double
childHeight Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
ch
needsUpdate :: Bool
needsUpdate = Bool
changedX Bool -> Bool -> Bool
|| Bool
changedY
makeWidget :: ScrollState -> WidgetResult s e
makeWidget ScrollState
state = WidgetEnv s e -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state
makeResult :: ScrollState -> WidgetResult s e
makeResult ScrollState
state = ScrollState -> WidgetResult s e
makeWidget ScrollState
state
WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollReqs
result :: Maybe (WidgetResult s e)
result
| Bool
needsUpdate = 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
$ ScrollState -> WidgetResult s e
makeResult ScrollState
newState
| Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
stepX :: Double
stepX = Double
wheelRate Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wx
stepY :: Double
stepY = Double
wheelRate Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wy
newState :: ScrollState
newState = ScrollState
state {
_sstDeltaX :: Double
_sstDeltaX = Double -> Double
scrollAxisH (Double
stepX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dx),
_sstDeltaY :: Double
_sstDeltaY = Double -> Double
scrollAxisV (Double
stepY Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy)
}
SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
where
theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
style :: StyleState
style = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
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
Rect Double
cx Double
cy Double
cw Double
ch = Rect
contentArea
sctx :: ScrollContext
sctx = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
mousePos
scrollReqs :: [WidgetRequest s e]
scrollReqs = [WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreParentEvents]
wheelCfg :: Rational
wheelCfg = Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Rational ThemeState Rational -> Rational
forall s a. s -> Getting a s a -> a
^. Getting Rational ThemeState Rational
forall s a. HasScrollWheelRate s a => Lens' s a
L.scrollWheelRate) (ScrollCfg s e -> Maybe Rational
forall s e. ScrollCfg s e -> Maybe Rational
_scWheelRate ScrollCfg s e
config)
wheelRate :: Double
wheelRate = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
wheelCfg
scrollAxis :: a -> a -> a -> a
scrollAxis a
reqDelta a
childLength a
vpLength
| a
maxDelta a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a
0
| a
reqDelta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a -> a -> a
forall a. Ord a => a -> a -> a
max a
reqDelta (-a
maxDelta)
| Bool
otherwise = a -> a -> a
forall a. Ord a => a -> a -> a
min a
reqDelta a
0
where
maxDelta :: a
maxDelta = a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a
childLength a -> a -> a
forall a. Num a => a -> a -> a
- a
vpLength)
scrollAxisH :: Double -> Double
scrollAxisH Double
delta = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
delta Double
childWidth Double
maxVpW
scrollAxisV :: Double -> Double
scrollAxisV Double
delta = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
delta Double
childHeight Double
maxVpH
handleMessage :: WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage WidgetEnv s e
wenv WidgetNode s e
node p
target a
message = Maybe (WidgetResult s e)
result where
handleScrollMessage :: ScrollMessage -> Maybe (WidgetResult s e)
handleScrollMessage (ScrollTo Rect
rect) = WidgetEnv s e -> WidgetNode s e -> Rect -> Maybe (WidgetResult s e)
scrollTo WidgetEnv s e
wenv WidgetNode s e
node Rect
rect
handleScrollMessage ScrollMessage
ScrollReset = WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
forall p. p -> WidgetNode s e -> Maybe (WidgetResult s e)
scrollReset WidgetEnv s e
wenv WidgetNode s e
node
result :: Maybe (WidgetResult s e)
result = a -> Maybe ScrollMessage
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
message Maybe ScrollMessage
-> (ScrollMessage -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScrollMessage -> Maybe (WidgetResult s e)
handleScrollMessage
scrollTo :: WidgetEnv s e -> WidgetNode s e -> Rect -> Maybe (WidgetResult s e)
scrollTo WidgetEnv s e
wenv WidgetNode s e
node Rect
targetRect = Maybe (WidgetResult s e)
result where
style :: StyleState
style = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
rect :: Rect
rect = Point -> Rect -> Rect
moveRect Point
offset Rect
targetRect
Rect Double
rx Double
ry Double
rw Double
rh = Rect
rect
Rect Double
cx Double
cy Double
_ Double
_ = Rect
contentArea
diffL :: Double
diffL = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rx
diffR :: Double
diffR = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
maxVpW Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
rx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rw)
diffT :: Double
diffT = Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ry
diffB :: Double
diffB = Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
maxVpH Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rh)
stepX :: Double
stepX
| Rect -> Rect -> Bool
rectInRectH Rect
rect Rect
contentArea = Double
dx
| Double -> Double
forall a. Num a => a -> a
abs Double
diffL Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Double
forall a. Num a => a -> a
abs Double
diffR = Double
diffL Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dx
| Bool
otherwise = Double
diffR Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dx
stepY :: Double
stepY
| Rect -> Rect -> Bool
rectInRectV Rect
rect Rect
contentArea = Double
dy
| Double -> Double
forall a. Num a => a -> a
abs Double
diffT Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Double
forall a. Num a => a -> a
abs Double
diffB = Double
diffT Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy
| Bool
otherwise = Double
diffB Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy
newState :: ScrollState
newState = ScrollState
state {
_sstDeltaX :: Double
_sstDeltaX = Double -> Double
scrollAxisH Double
stepX,
_sstDeltaY :: Double
_sstDeltaY = Double -> Double
scrollAxisV Double
stepY
}
result :: Maybe (WidgetResult s e)
result
| Rect -> Rect -> Bool
rectInRect Rect
rect Rect
contentArea = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
| Bool
otherwise = 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
$ WidgetEnv s e -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget WidgetEnv s e
wenv WidgetNode s e
node ScrollState
newState
scrollReset :: p -> WidgetNode s e -> Maybe (WidgetResult s e)
scrollReset p
wenv WidgetNode s e
node = Maybe (WidgetResult s e)
result where
newState :: ScrollState
newState = ScrollState
state {
_sstDeltaX :: Double
_sstDeltaX = Double
0,
_sstDeltaY :: Double
_sstDeltaY = Double
0
}
result :: Maybe (WidgetResult s e)
result = 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
$ p -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget p
wenv WidgetNode s e
node ScrollState
newState
updateScrollThumb :: ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
activeBar Point
point Rect
contentArea ScrollContext
sctx = ScrollState
newState where
Point Double
px Double
py = Point
point
ScrollContext{Bool
Double
Rect
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRequired :: Bool
hScrollRequired :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
vThumbRect :: ScrollContext -> Rect
hThumbRect :: ScrollContext -> Rect
vScrollRect :: ScrollContext -> Rect
hScrollRect :: ScrollContext -> Rect
vMouseInThumb :: ScrollContext -> Bool
hMouseInThumb :: ScrollContext -> Bool
vMouseInScroll :: ScrollContext -> Bool
hMouseInScroll :: ScrollContext -> Bool
vScrollRequired :: ScrollContext -> Bool
hScrollRequired :: ScrollContext -> Bool
vScrollRatio :: ScrollContext -> Double
hScrollRatio :: ScrollContext -> Double
..} = ScrollContext
sctx
Rect Double
cx Double
cy Double
_ Double
_ = Rect
contentArea
hMid :: Double
hMid = Rect -> Double
_rW Rect
hThumbRect Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
vMid :: Double
vMid = Rect -> Double
_rH Rect
vThumbRect Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
hDelta :: Double
hDelta = (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hMid) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
hScrollRatio
vDelta :: Double
vDelta = (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
vMid) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
vScrollRatio
newDeltaX :: Double
newDeltaX
| ActiveBar
activeBar ActiveBar -> ActiveBar -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveBar
HBar = Double -> Double
scrollAxisH Double
hDelta
| Bool
otherwise = Double
dx
newDeltaY :: Double
newDeltaY
| ActiveBar
activeBar ActiveBar -> ActiveBar -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveBar
VBar = Double -> Double
scrollAxisV Double
vDelta
| Bool
otherwise = Double
dy
newState :: ScrollState
newState = ScrollState
state {
_sstDeltaX :: Double
_sstDeltaX = Double
newDeltaX,
_sstDeltaY :: Double
_sstDeltaY = Double
newDeltaY
}
rebuildWidget :: p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget p
wenv WidgetNode s e
node ScrollState
newState = 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
.~ ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
newState
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
getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq, SizeReq)
sizeReq where
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
tw :: Double
tw = SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
th :: Double
th = SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
Size Double
w Double
h = 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 (Double -> Double -> Size
Size Double
tw Double
th))
factor :: Double
factor = Double
1
sizeReq :: (SizeReq, SizeReq)
sizeReq = (Double -> Double -> SizeReq
expandSize Double
w Double
factor, Double -> Double -> SizeReq
expandSize Double
h Double
factor)
resize :: WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport p
children = (WidgetResult s e, Seq Rect)
result where
theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
style :: StyleState
style = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
Rect Double
cl Double
ct Double
cw Double
ch = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
dx :: Double
dx = ScrollState -> Double
_sstDeltaX ScrollState
state
dy :: Double
dy = ScrollState -> Double
_sstDeltaY ScrollState
state
child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (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) Int
0
childW :: Double
childW = SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
childH :: Double
childH = SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
barW :: Double
barW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollBarWidth s a => Lens' s a
L.scrollBarWidth) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
config)
overlay :: Bool
overlay = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Bool ThemeState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool ThemeState Bool
forall s a. HasScrollOverlay s a => Lens' s a
L.scrollOverlay) (ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay ScrollCfg s e
config)
(Double
ncw, Double
nch)
| Bool -> Bool
not Bool
overlay = (Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW, Double
ch Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW)
| Bool
otherwise = (Double
cw, Double
ch)
(Double
maxW, Double
areaW)
| ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollV Bool -> Bool -> Bool
&& Double
childH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
ch = (Double
ncw, Double
ncw)
| ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollV = (Double
cw, Double
cw)
| ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollH = (Double
cw, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
cw Double
childW)
| Double
childH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
ch Bool -> Bool -> Bool
&& Double
childW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
cw = (Double
cw, Double
cw)
| Double
childH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
ch = (Double
cw, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
cw Double
childW)
| Bool
otherwise = (Double
ncw, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
ncw Double
childW)
(Double
maxH, Double
areaH)
| ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollH Bool -> Bool -> Bool
&& Double
childW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cw = (Double
nch, Double
nch)
| ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollH = (Double
ch, Double
ch)
| ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollV = (Double
ch, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
ch Double
childH)
| Double
childW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
cw Bool -> Bool -> Bool
&& Double
childH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
ch = (Double
ch, Double
ch)
| Double
childW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
cw = (Double
ch, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
ch Double
childH)
| Bool
otherwise = (Double
nch, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
nch Double
childH)
newDx :: Double
newDx = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
dx Double
areaW Double
maxW
newDy :: Double
newDy = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
dy Double
areaH Double
maxH
scissor :: Rect
scissor = Double -> Double -> Double -> Double -> Rect
Rect Double
cl Double
ct Double
maxW Double
maxH
cViewport :: Rect
cViewport = Double -> Double -> Double -> Double -> Rect
Rect Double
cl Double
ct Double
areaW Double
areaH
newState :: ScrollState
newState = ScrollState
state {
_sstDeltaX :: Double
_sstDeltaX = Double
newDx,
_sstDeltaY :: Double
_sstDeltaY = Double
newDy,
_sstVpSize :: Size
_sstVpSize = Double -> Double -> Size
Size Double
maxW Double
maxH,
_sstChildSize :: Size
_sstChildSize = Double -> Double -> Size
Size Double
areaW Double
areaH,
_sstScissor :: Rect
_sstScissor = Rect
scissor
}
newNode :: WidgetResult s e
newNode = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
forall a b. (a -> b) -> a -> b
$ 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
.~ ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
newState
result :: (WidgetResult s e, Seq Rect)
result = (WidgetResult s e
newNode, Rect -> Seq Rect
forall a. a -> Seq a
Seq.singleton Rect
cViewport)
renderAfter :: ContainerRenderHandler s e
renderAfter WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hScrollRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
hScrollRect Maybe Color
barColorH Maybe Radius
forall a. Maybe a
Nothing
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
vScrollRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
vScrollRect Maybe Color
barColorV Maybe Radius
forall a. Maybe a
Nothing
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hScrollRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
hThumbRect Maybe Color
thumbColorH Maybe Radius
thumbRadius
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
vScrollRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
vThumbRect Maybe Color
thumbColorV Maybe Radius
thumbRadius
where
ScrollContext{Bool
Double
Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
vScrollRequired :: Bool
hScrollRect :: Rect
hScrollRequired :: Bool
vThumbRect :: ScrollContext -> Rect
hThumbRect :: ScrollContext -> Rect
vScrollRect :: ScrollContext -> Rect
hScrollRect :: ScrollContext -> Rect
vMouseInThumb :: ScrollContext -> Bool
hMouseInThumb :: ScrollContext -> Bool
vMouseInScroll :: ScrollContext -> Bool
hMouseInScroll :: ScrollContext -> Bool
vScrollRequired :: ScrollContext -> Bool
hScrollRequired :: ScrollContext -> Bool
vScrollRatio :: ScrollContext -> Double
hScrollRatio :: ScrollContext -> Double
..} = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
mousePos
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
draggingH :: Bool
draggingH = ScrollState -> Maybe ActiveBar
_sstDragging ScrollState
state Maybe ActiveBar -> Maybe ActiveBar -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveBar -> Maybe ActiveBar
forall a. a -> Maybe a
Just ActiveBar
HBar
draggingV :: Bool
draggingV = ScrollState -> Maybe ActiveBar
_sstDragging ScrollState
state Maybe ActiveBar -> Maybe ActiveBar -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveBar -> Maybe ActiveBar
forall a. a -> Maybe a
Just ActiveBar
VBar
theme :: Theme
theme = WidgetEnv s e
wenv WidgetEnv s e -> Getting Theme (WidgetEnv s e) Theme -> Theme
forall s a. s -> Getting a s a -> a
^. Getting Theme (WidgetEnv s e) Theme
forall s a. HasTheme s a => Lens' s a
L.theme
athm :: ThemeState
athm = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
tmpRad :: Double
tmpRad = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
athm ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollThumbRadius s a => Lens' s a
L.scrollThumbRadius) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbRadius ScrollCfg s e
config)
thumbRadius :: Maybe Radius
thumbRadius
| Double
tmpRad Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Radius -> Maybe Radius
forall a. a -> Maybe a
Just (Double -> Radius
forall t. CmbRadius t => Double -> t
radius Double
tmpRad)
| Bool
otherwise = Maybe Radius
forall a. Maybe a
Nothing
cfgBarBCol :: Maybe Color
cfgBarBCol = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarColor ScrollCfg s e
config
cfgBarHCol :: Maybe Color
cfgBarHCol = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarHoverColor ScrollCfg s e
config
cfgThumbBCol :: Maybe Color
cfgThumbBCol = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbColor ScrollCfg s e
config
cfgThumbHCol :: Maybe Color
cfgThumbHCol = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbHoverColor ScrollCfg s e
config
barBCol :: Maybe Color
barBCol = Maybe Color
cfgBarBCol Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Color -> Maybe Color
forall a. a -> Maybe a
Just (Theme
theme Theme -> Getting Color Theme Color -> Color
forall s a. s -> Getting a s a -> a
^. (ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme
forall s a. HasBasic s a => Lens' s a
L.basic ((ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme)
-> ((Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState)
-> Getting Color Theme Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState
forall s a. HasScrollBarColor s a => Lens' s a
L.scrollBarColor)
barHCol :: Maybe Color
barHCol = Maybe Color
cfgBarHCol Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Color -> Maybe Color
forall a. a -> Maybe a
Just (Theme
theme Theme -> Getting Color Theme Color -> Color
forall s a. s -> Getting a s a -> a
^. (ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme
forall s a. HasHover s a => Lens' s a
L.hover ((ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme)
-> ((Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState)
-> Getting Color Theme Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState
forall s a. HasScrollBarColor s a => Lens' s a
L.scrollBarColor)
thumbBCol :: Maybe Color
thumbBCol = Maybe Color
cfgThumbBCol Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Color -> Maybe Color
forall a. a -> Maybe a
Just (Theme
theme Theme -> Getting Color Theme Color -> Color
forall s a. s -> Getting a s a -> a
^. (ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme
forall s a. HasBasic s a => Lens' s a
L.basic ((ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme)
-> ((Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState)
-> Getting Color Theme Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState
forall s a. HasScrollThumbColor s a => Lens' s a
L.scrollThumbColor)
thumbHCol :: Maybe Color
thumbHCol = Maybe Color
cfgThumbHCol Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Color -> Maybe Color
forall a. a -> Maybe a
Just (Theme
theme Theme -> Getting Color Theme Color -> Color
forall s a. s -> Getting a s a -> a
^. (ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme
forall s a. HasHover s a => Lens' s a
L.hover((ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme)
-> ((Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState)
-> Getting Color Theme Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState
forall s a. HasScrollThumbColor s a => Lens' s a
L.scrollThumbColor)
barColorH :: Maybe Color
barColorH
| Bool
hMouseInScroll = Maybe Color
barHCol
| Bool
otherwise = Maybe Color
barBCol
barColorV :: Maybe Color
barColorV
| Bool
vMouseInScroll = Maybe Color
barHCol
| Bool
otherwise = Maybe Color
barBCol
thumbColorH :: Maybe Color
thumbColorH
| Bool
hMouseInThumb Bool -> Bool -> Bool
|| Bool
draggingH = Maybe Color
thumbHCol
| Bool
otherwise = Maybe Color
thumbBCol
thumbColorV :: Maybe Color
thumbColorV
| Bool
vMouseInThumb Bool -> Bool -> Bool
|| Bool
draggingV = Maybe Color
thumbHCol
| Bool
otherwise = Maybe Color
thumbBCol
scrollCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
| WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
child = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle WidgetEnv s e
wenv WidgetNode s e
node
| Bool
otherwise = 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
where
child :: WidgetNode s e
child = 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 Seq (WidgetNode s e)
-> Getting
(Endo (WidgetNode s e)) (Seq (WidgetNode s e)) (WidgetNode s e)
-> WidgetNode s e
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Seq (WidgetNode s e))
-> Traversal'
(Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Seq (WidgetNode s e))
0
scrollStatus
:: ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus :: ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
scrollState Point
mousePos = ScrollContext :: Double
-> Double
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Rect
-> Rect
-> Rect
-> Rect
-> ScrollContext
ScrollContext{Bool
Double
Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vScrollRequired :: Bool
hScrollRequired :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRequired :: Bool
hScrollRequired :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
..} where
ScrollState Maybe ActiveBar
_ Double
dx Double
dy Size
_ Size
_ Rect
_ = ScrollState
scrollState
Size Double
childWidth Double
childHeight = ScrollState -> Size
_sstChildSize ScrollState
scrollState
Size Double
vpWidth Double
vpHeight = ScrollState -> Size
_sstVpSize ScrollState
scrollState
theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
barW :: Double
barW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollBarWidth s a => Lens' s a
L.scrollBarWidth) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
config)
thumbW :: Double
thumbW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollThumbWidth s a => Lens' s a
L.scrollThumbWidth) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbWidth ScrollCfg s e
config)
caLeft :: Double
caLeft = Rect -> Double
_rX Rect
contentArea
caTop :: Double
caTop = Rect -> Double
_rY Rect
contentArea
caWidth :: Double
caWidth = Rect -> Double
_rW Rect
contentArea
caHeight :: Double
caHeight = Rect -> Double
_rH Rect
contentArea
hScrollTop :: Double
hScrollTop = Double
caHeight Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW
vScrollLeft :: Double
vScrollLeft = Double
caWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW
hRatio :: Double
hRatio = Double
caWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
childWidth
vRatio :: Double
vRatio = Double
caHeight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
childHeight
hRatioR :: Double
hRatioR = (Double
caWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
childWidth
vRatioR :: Double
vRatioR = (Double
caHeight Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
childHeight
(Double
hScrollRatio, Double
vScrollRatio)
| Double
hRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
&& Double
vRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 = (Double
hRatioR, Double
vRatioR)
| Bool
otherwise = (Double
hRatio, Double
vRatio)
hScrollRequired :: Bool
hScrollRequired = Double
hScrollRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1
vScrollRequired :: Bool
vScrollRequired = Double
vScrollRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1
hScrollRect :: Rect
hScrollRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
_rX :: Double
_rX = Double
caLeft,
_rY :: Double
_rY = Double
caTop Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hScrollTop,
_rW :: Double
_rW = Double
vpWidth,
_rH :: Double
_rH = Double
barW
}
vScrollRect :: Rect
vScrollRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
_rX :: Double
_rX = Double
caLeft Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
vScrollLeft,
_rY :: Double
_rY = Double
caTop,
_rW :: Double
_rW = Double
barW,
_rH :: Double
_rH = Double
vpHeight
}
hThumbRect :: Rect
hThumbRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
_rX :: Double
_rX = Double
caLeft Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hScrollRatio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dx,
_rY :: Double
_rY = Double
caTop Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hScrollTop Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
barW Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
thumbW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2,
_rW :: Double
_rW = Double
hScrollRatio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
vpWidth,
_rH :: Double
_rH = Double
thumbW
}
vThumbRect :: Rect
vThumbRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
_rX :: Double
_rX = Double
caLeft Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
vScrollLeft Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
barW Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
thumbW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2,
_rY :: Double
_rY = Double
caTop Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vScrollRatio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dy,
_rW :: Double
_rW = Double
thumbW,
_rH :: Double
_rH = Double
vScrollRatio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
vpHeight
}
hMouseInScroll :: Bool
hMouseInScroll = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
hScrollRect
vMouseInScroll :: Bool
vMouseInScroll = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
vScrollRect
hMouseInThumb :: Bool
hMouseInThumb = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
hThumbRect
vMouseInThumb :: Bool
vMouseInThumb = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
vThumbRect
findInstOrScroll
:: WidgetEnv s e -> WidgetNode s e -> Seq.Seq PathStep -> Maybe WidgetNodeInfo
findInstOrScroll :: WidgetEnv s e -> WidgetNode s e -> Seq Int -> Maybe WidgetNodeInfo
findInstOrScroll WidgetEnv s e
wenv WidgetNode s e
node Seq Int
target = Maybe WidgetNodeInfo
wniScroll Maybe WidgetNodeInfo
-> Maybe WidgetNodeInfo -> Maybe WidgetNodeInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe WidgetNodeInfo
wniTarget where
child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (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) Int
0
isScroll :: s -> Bool
isScroll s
wni = s
wni s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasWidgetType s a => Lens' s a
L.widgetType a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"scroll"
branch :: Seq WidgetNodeInfo
branch = Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Seq Int -> Seq WidgetNodeInfo
forall s e.
Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Seq Int -> Seq WidgetNodeInfo
widgetFindBranchByPath (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 Seq Int
target
scrolls :: Seq WidgetNodeInfo
scrolls = (WidgetNodeInfo -> Bool)
-> Seq WidgetNodeInfo -> Seq WidgetNodeInfo
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter WidgetNodeInfo -> Bool
forall a s. (Eq a, HasWidgetType s a, IsString a) => s -> Bool
isScroll Seq WidgetNodeInfo
branch
wniTarget :: Maybe WidgetNodeInfo
wniTarget = Int -> Seq WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq WidgetNodeInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
branch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
branch
wniScroll :: Maybe WidgetNodeInfo
wniScroll = Int -> Seq WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq WidgetNodeInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
scrolls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
scrolls