{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Util.Style (
collectStyleField,
collectStyleField_,
currentTheme,
currentTheme_,
currentStyle,
currentStyle_,
focusedStyle,
styleStateChanged,
initNodeStyle,
mergeBasicStyle,
handleStyleChange,
childOfFocusedStyle
) where
import Control.Applicative ((<|>))
import Control.Lens (Lens', (&), (^.), (^?), (.~), (?~), (<>~), _Just, _1, non)
import Data.Bits (xor)
import Data.Default
import Data.Maybe
import Data.Sequence (Seq(..), (<|), (|>))
import qualified Data.Sequence as Seq
import Monomer.Core
import Monomer.Event
import Monomer.Helper
import Monomer.Widgets.Util.Focus
import Monomer.Widgets.Util.Hover
import Monomer.Widgets.Util.Types
import Monomer.Widgets.Util.Widget
import qualified Monomer.Core.Lens as L
import qualified Monomer.Event.Lens as L
instance Default (CurrentStyleCfg s e) where
def :: CurrentStyleCfg s e
def = CurrentStyleCfg {
_ascIsHovered :: IsHovered s e
_ascIsHovered = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered,
_ascIsFocused :: IsHovered s e
_ascIsFocused = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused,
_ascIsActive :: IsHovered s e
_ascIsActive = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeActive
}
collectStyleField
:: Lens' StyleState (Maybe t)
-> Style
-> Style
collectStyleField :: forall t. Lens' StyleState (Maybe t) -> Style -> Style
collectStyleField Lens' StyleState (Maybe t)
fieldS Style
source = forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ Lens' StyleState (Maybe t)
fieldS Style
source forall a. Default a => a
def
collectStyleField_
:: Lens' StyleState (Maybe t)
-> Style
-> Style
-> Style
collectStyleField_ :: forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ Lens' StyleState (Maybe t)
fieldS Style
source Style
target = Style
style where
setValue :: Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
setValue Getting (Maybe StyleState) Style (Maybe StyleState)
stateLens = Maybe StyleState
result where
sourceState :: Maybe StyleState
sourceState = Style
source forall s a. s -> Getting a s a -> a
^. Getting (Maybe StyleState) Style (Maybe StyleState)
stateLens
targetState :: Maybe StyleState
targetState = Style
target forall s a. s -> Getting a s a -> a
^. Getting (Maybe StyleState) Style (Maybe StyleState)
stateLens
value :: Maybe t
value = Maybe StyleState
sourceState forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' StyleState (Maybe t)
fieldS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
setTarget :: t -> StyleState
setTarget t
val = Maybe StyleState
targetState forall s a. s -> Getting a s a -> a
^. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe t)
fieldS forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ t
val
resetTarget :: StyleState
resetTarget = Maybe StyleState
targetState forall s a. s -> Getting a s a -> a
^. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe t)
fieldS forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
result :: Maybe StyleState
result
| forall a. Maybe a -> Bool
isJust Maybe t
value = t -> StyleState
setTarget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe t
value
| forall a. Maybe a -> Bool
isJust Maybe StyleState
targetState = forall a. a -> Maybe a
Just StyleState
resetTarget
| Bool
otherwise = forall a. Maybe a
Nothing
basic :: Maybe StyleState
basic = Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
setValue forall s a. HasBasic s a => Lens' s a
L.basic
hover :: Maybe StyleState
hover = Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
setValue forall s a. HasHover s a => Lens' s a
L.hover
focus :: Maybe StyleState
focus = Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
setValue forall s a. HasFocus s a => Lens' s a
L.focus
focusHover :: Maybe StyleState
focusHover = Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
setValue forall s a. HasFocusHover s a => Lens' s a
L.focusHover
active :: Maybe StyleState
active = Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
setValue forall s a. HasActive s a => Lens' s a
L.active
disabled :: Maybe StyleState
disabled = Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
setValue forall s a. HasDisabled s a => Lens' s a
L.disabled
style :: Style
style = Maybe StyleState
-> Maybe StyleState
-> Maybe StyleState
-> Maybe StyleState
-> Maybe StyleState
-> Maybe StyleState
-> Style
Style Maybe StyleState
basic Maybe StyleState
hover Maybe StyleState
focus Maybe StyleState
focusHover Maybe StyleState
active Maybe StyleState
disabled
currentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle :: forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node = forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ forall a. Default a => a
def WidgetEnv s e
wenv WidgetNode s e
node
currentStyle_
:: CurrentStyleCfg s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ :: forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ CurrentStyleCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def Maybe StyleState
styleState where
Style{Maybe StyleState
_styleDisabled :: Style -> Maybe StyleState
_styleActive :: Style -> Maybe StyleState
_styleFocusHover :: Style -> Maybe StyleState
_styleFocus :: Style -> Maybe StyleState
_styleHover :: Style -> Maybe StyleState
_styleBasic :: Style -> Maybe StyleState
_styleDisabled :: Maybe StyleState
_styleActive :: Maybe StyleState
_styleFocusHover :: Maybe StyleState
_styleFocus :: Maybe StyleState
_styleHover :: Maybe StyleState
_styleBasic :: Maybe StyleState
..} = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style
mousePos :: Point
mousePos = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos
isEnabled :: Bool
isEnabled = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEnabled s a => Lens' s a
L.enabled
isHover :: Bool
isHover = forall s e. CurrentStyleCfg s e -> IsHovered s e
_ascIsHovered CurrentStyleCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node
isFocus :: Bool
isFocus = forall s e. CurrentStyleCfg s e -> IsHovered s e
_ascIsFocused CurrentStyleCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node
isActive :: Bool
isActive = forall s e. CurrentStyleCfg s e -> IsHovered s e
_ascIsActive CurrentStyleCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node
styleState :: Maybe StyleState
styleState
| Bool -> Bool
not Bool
isEnabled = Maybe StyleState
_styleDisabled
| Bool
isActive = Maybe StyleState
_styleActive
| Bool
isHover Bool -> Bool -> Bool
&& Bool
isFocus = Maybe StyleState
_styleFocusHover
| Bool
isHover = Maybe StyleState
_styleHover
| Bool
isFocus = Maybe StyleState
_styleFocus
| Bool
otherwise = Maybe StyleState
_styleBasic
focusedStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle :: forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle WidgetEnv s e
wenv WidgetNode s e
node = forall s e.
IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle_ forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
node
focusedStyle_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle_ :: forall s e.
IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle_ IsHovered s e
isHoveredFn WidgetEnv s e
wenv WidgetNode s e
node = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def Maybe StyleState
styleState where
Style{Maybe StyleState
_styleDisabled :: Maybe StyleState
_styleActive :: Maybe StyleState
_styleFocusHover :: Maybe StyleState
_styleFocus :: Maybe StyleState
_styleHover :: Maybe StyleState
_styleBasic :: Maybe StyleState
_styleDisabled :: Style -> Maybe StyleState
_styleActive :: Style -> Maybe StyleState
_styleFocusHover :: Style -> Maybe StyleState
_styleFocus :: Style -> Maybe StyleState
_styleHover :: Style -> Maybe StyleState
_styleBasic :: Style -> Maybe StyleState
..} = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style
isHover :: Bool
isHover = IsHovered s e
isHoveredFn WidgetEnv s e
wenv WidgetNode s e
node
styleState :: Maybe StyleState
styleState
| Bool
isHover = Maybe StyleState
_styleFocusHover
| Bool
otherwise = Maybe StyleState
_styleFocus
currentTheme :: WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme :: forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node = forall s e.
IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme_ forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
node
currentTheme_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme_ :: forall s e.
IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme_ IsHovered s e
isHoveredFn WidgetEnv s e
wenv WidgetNode s e
node = ThemeState
themeState where
theme :: Theme
theme = forall s e. WidgetEnv s e -> Theme
_weTheme WidgetEnv s e
wenv
mousePos :: Point
mousePos = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos
isEnabled :: Bool
isEnabled = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEnabled s a => Lens' s a
L.enabled
isHover :: Bool
isHover = IsHovered s e
isHoveredFn WidgetEnv s e
wenv WidgetNode s e
node
isFocus :: Bool
isFocus = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
isActive :: Bool
isActive = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeActive WidgetEnv s e
wenv WidgetNode s e
node
themeState :: ThemeState
themeState
| Bool -> Bool
not Bool
isEnabled = Theme -> ThemeState
_themeDisabled Theme
theme
| Bool
isActive = Theme -> ThemeState
_themeActive Theme
theme
| Bool
isHover Bool -> Bool -> Bool
&& Bool
isFocus = Theme -> ThemeState
_themeFocusHover Theme
theme
| Bool
isHover = Theme -> ThemeState
_themeHover Theme
theme
| Bool
isFocus = Theme -> ThemeState
_themeFocus Theme
theme
| Bool
otherwise = Theme -> ThemeState
_themeBasic Theme
theme
styleStateChanged :: WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
styleStateChanged :: forall s e. WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
styleStateChanged WidgetEnv s e
wenv WidgetNode s e
node SystemEvent
evt = Bool
hoverChanged Bool -> Bool -> Bool
|| Bool
focusChanged where
hoverChanged :: Bool
hoverChanged = SystemEvent -> Bool
isOnEnter SystemEvent
evt Bool -> Bool -> Bool
|| SystemEvent -> Bool
isOnLeave SystemEvent
evt
focusChanged :: Bool
focusChanged = SystemEvent -> Bool
isOnFocus SystemEvent
evt Bool -> Bool -> Bool
|| SystemEvent -> Bool
isOnBlur SystemEvent
evt
initNodeStyle
:: GetBaseStyle s e
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
initNodeStyle :: forall s e.
GetBaseStyle s e
-> WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
initNodeStyle GetBaseStyle s e
getBaseStyle WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e
newNode where
nodeStyle :: Style
nodeStyle = Style -> Style
mergeBasicStyle forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style
baseStyle :: Style
baseStyle = Style -> Style
mergeBasicStyle forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (GetBaseStyle s e
getBaseStyle WidgetEnv s e
wenv WidgetNode s e
node)
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Style
baseStyle forall a. Semigroup a => a -> a -> a
<> Style
nodeStyle)
mergeBasicStyle :: Style -> Style
mergeBasicStyle :: Style -> Style
mergeBasicStyle Style
st = Style
newStyle where
focusHover :: Maybe StyleState
focusHover = Style -> Maybe StyleState
_styleHover Style
st forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleFocus Style
st forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleFocusHover Style
st
active :: Maybe StyleState
active = Maybe StyleState
focusHover forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleActive Style
st
newStyle :: Style
newStyle = Style {
_styleBasic :: Maybe StyleState
_styleBasic = Style -> Maybe StyleState
_styleBasic Style
st,
_styleHover :: Maybe StyleState
_styleHover = Style -> Maybe StyleState
_styleBasic Style
st forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleHover Style
st,
_styleFocus :: Maybe StyleState
_styleFocus = Style -> Maybe StyleState
_styleBasic Style
st forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleFocus Style
st,
_styleFocusHover :: Maybe StyleState
_styleFocusHover = Style -> Maybe StyleState
_styleBasic Style
st forall a. Semigroup a => a -> a -> a
<> Maybe StyleState
focusHover,
_styleActive :: Maybe StyleState
_styleActive = Style -> Maybe StyleState
_styleBasic Style
st forall a. Semigroup a => a -> a -> a
<> Maybe StyleState
active,
_styleDisabled :: Maybe StyleState
_styleDisabled = Style -> Maybe StyleState
_styleBasic Style
st forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleDisabled Style
st
}
handleStyleChange
:: WidgetEnv s e
-> Path
-> StyleState
-> Bool
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleStyleChange :: forall s e.
WidgetEnv s e
-> Path
-> StyleState
-> Bool
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleStyleChange WidgetEnv s e
wenv Path
target StyleState
style Bool
doCursor WidgetNode s e
node SystemEvent
evt Maybe (WidgetResult s e)
result = Maybe (WidgetResult s e)
newResult where
tmpResult :: Maybe (WidgetResult s e)
tmpResult = forall s e.
WidgetEnv s e
-> Path
-> SystemEvent
-> WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeChange WidgetEnv s e
wenv Path
target SystemEvent
evt WidgetNode s e
node Maybe (WidgetResult s e)
result
newResult :: Maybe (WidgetResult s e)
newResult
| Bool
doCursor = forall s e.
WidgetEnv s e
-> Path
-> SystemEvent
-> StyleState
-> WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleCursorChange WidgetEnv s e
wenv Path
target SystemEvent
evt StyleState
style WidgetNode s e
node Maybe (WidgetResult s e)
tmpResult
| Bool
otherwise = Maybe (WidgetResult s e)
tmpResult
childOfFocusedStyle
:: WidgetEnv s e
-> WidgetNode s e
-> StyleState
childOfFocusedStyle :: forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
childOfFocusedStyle WidgetEnv s e
wenv WidgetNode s e
cnode = StyleState
newStyle where
branch :: Seq WidgetNodeInfo
branch = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFindBranchByPath s a => Lens' s a
L.findBranchByPath forall a b. (a -> b) -> a -> b
$ forall s e. WidgetNode s e -> Path
parentPath WidgetNode s e
cnode
pinfo :: WidgetNodeInfo
pinfo = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (forall a. Int -> Seq a -> Maybe a
Seq.lookup (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
branch forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
branch)
cstyle :: Style
cstyle = WidgetNode s e
cnode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style
enabled :: Bool
enabled = WidgetNode s e
cnode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEnabled s a => Lens' s a
L.enabled
activeC :: Bool
activeC = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeActive WidgetEnv s e
wenv WidgetNode s e
cnode
activeP :: Bool
activeP = forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoActive Bool
False WidgetEnv s e
wenv WidgetNodeInfo
pinfo
hoverC :: Bool
hoverC = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
cnode
hoverP :: Bool
hoverP = forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoHovered WidgetEnv s e
wenv WidgetNodeInfo
pinfo
focusP :: Bool
focusP = forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoFocused WidgetEnv s e
wenv WidgetNodeInfo
pinfo
newStyle :: StyleState
newStyle
| Bool -> Bool
not Bool
enabled = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (Style -> Maybe StyleState
_styleDisabled Style
cstyle)
| Bool
activeC Bool -> Bool -> Bool
|| Bool
activeP = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (Style -> Maybe StyleState
_styleActive Style
cstyle)
| (Bool
hoverC Bool -> Bool -> Bool
|| Bool
hoverP) Bool -> Bool -> Bool
&& Bool
focusP = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (Style -> Maybe StyleState
_styleFocusHover Style
cstyle)
| Bool
hoverC Bool -> Bool -> Bool
|| Bool
hoverP = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (Style -> Maybe StyleState
_styleHover Style
cstyle)
| Bool
focusP = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (Style -> Maybe StyleState
_styleFocus Style
cstyle)
| Bool
otherwise = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
cnode
handleSizeChange
:: WidgetEnv s e
-> Path
-> SystemEvent
-> WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeChange :: forall s e.
WidgetEnv s e
-> Path
-> SystemEvent
-> WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeChange WidgetEnv s e
wenv Path
target SystemEvent
evt WidgetNode s e
oldNode Maybe (WidgetResult s e)
result = Maybe (WidgetResult s e)
newResult where
baseResult :: WidgetResult s e
baseResult = forall a. a -> Maybe a -> a
fromMaybe (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
oldNode) Maybe (WidgetResult s e)
result
newNode :: WidgetNode s e
newNode = WidgetResult s e
baseResult forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node
widgetId :: WidgetId
widgetId = WidgetNode s e
newNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
path :: Path
path = WidgetNode s e
newNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
oldSizeReqW :: SizeReq
oldSizeReqW = WidgetNode s e
oldNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
oldSizeReqH :: SizeReq
oldSizeReqH = WidgetNode s e
oldNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
newSizeReqW :: SizeReq
newSizeReqW = WidgetNode s e
newNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
newSizeReqH :: SizeReq
newSizeReqH = WidgetNode s e
newNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
sizeReqChanged :: Bool
sizeReqChanged = SizeReq
oldSizeReqW forall a. Eq a => a -> a -> Bool
/= SizeReq
newSizeReqW Bool -> Bool -> Bool
|| SizeReq
oldSizeReqH forall a. Eq a => a -> a -> Bool
/= SizeReq
newSizeReqH
prevInVp :: Bool
prevInVp = forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
newNode (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePosPrev s a => Lens' s a
L.mousePosPrev)
currInVp :: Bool
currInVp = forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
newNode (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos)
pressedPath :: Maybe Path
pressedPath = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1
hoverDragChg :: Bool
hoverDragChg = forall a. a -> Maybe a
Just Path
path forall a. Eq a => a -> a -> Bool
== Maybe Path
pressedPath Bool -> Bool -> Bool
&& Bool
prevInVp forall a. Eq a => a -> a -> Bool
/= Bool
currInVp
renderReq :: Bool
renderReq = SystemEvent -> Bool
isOnEnter SystemEvent
evt Bool -> Bool -> Bool
|| SystemEvent -> Bool
isOnLeave SystemEvent
evt Bool -> Bool -> Bool
|| Bool
hoverDragChg
resizeReq :: [WidgetRequest s e]
resizeReq = [ forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId | Bool
sizeReqChanged ]
enterReq :: [WidgetRequest s e]
enterReq = [ forall s e. WidgetRequest s e
RenderOnce | Bool
renderReq ]
reqs :: [WidgetRequest s e]
reqs = forall {s} {e}. [WidgetRequest s e]
resizeReq forall a. [a] -> [a] -> [a]
++ forall {s} {e}. [WidgetRequest s e]
enterReq
newResult :: Maybe (WidgetResult s e)
newResult
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall {s} {e}. [WidgetRequest s e]
reqs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
baseResult
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList forall {s} {e}. [WidgetRequest s e]
reqs
| Bool
otherwise = Maybe (WidgetResult s e)
result
handleCursorChange
:: WidgetEnv s e
-> Path
-> SystemEvent
-> StyleState
-> WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleCursorChange :: forall s e.
WidgetEnv s e
-> Path
-> SystemEvent
-> StyleState
-> WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleCursorChange WidgetEnv s e
wenv Path
target SystemEvent
evt StyleState
style WidgetNode s e
oldNode Maybe (WidgetResult s e)
result = Maybe (WidgetResult s e)
newResult where
baseResult :: WidgetResult s e
baseResult = forall a. a -> Maybe a -> a
fromMaybe (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
oldNode) Maybe (WidgetResult s e)
result
baseReqs :: Seq (WidgetRequest s e)
baseReqs = WidgetResult s e
baseResult forall s a. s -> Getting a s a -> a
^. forall s a. HasRequests s a => Lens' s a
L.requests
node :: WidgetNode s e
node = WidgetResult s e
baseResult forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
path :: Path
path = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
isTarget :: Bool
isTarget = Path
path forall a. Eq a => a -> a -> Bool
== Path
target
hasCursor :: Bool
hasCursor = forall a. Maybe a -> Bool
isJust (StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon)
isPressed :: Bool
isPressed = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node
(Path
curPath, CursorIcon
curIcon) = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasCursor s a => Lens' s a
L.cursor)
isParent :: Bool
isParent = forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
path Path
curPath Bool -> Bool -> Bool
&& Path
path forall a. Eq a => a -> a -> Bool
/= Path
curPath
newIcon :: CursorIcon
newIcon = forall a. a -> Maybe a -> a
fromMaybe CursorIcon
CursorArrow (StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon)
setCursor :: Bool
setCursor = Bool
hasCursor
Bool -> Bool -> Bool
&& SystemEvent -> Bool
isCursorEvt SystemEvent
evt
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isParent
Bool -> Bool -> Bool
&& CursorIcon
curIcon forall a. Eq a => a -> a -> Bool
/= CursorIcon
newIcon
resetCursor :: Bool
resetCursor = Bool
isTarget
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasCursor
Bool -> Bool -> Bool
&& SystemEvent -> Bool
isCursorEvt SystemEvent
evt
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isPressed
Bool -> Bool -> Bool
&& Path
curPath forall a. Eq a => a -> a -> Bool
== Path
path
newResult :: Maybe (WidgetResult s e)
newResult
| Bool
setCursor = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
baseResult
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
newIcon forall a. a -> Seq a -> Seq a
<| Seq (WidgetRequest s e)
baseReqs
| Bool
resetCursor = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
baseResult
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetRequest s e)
baseReqs forall a. Seq a -> a -> Seq a
|> forall s e. WidgetId -> WidgetRequest s e
ResetCursorIcon WidgetId
widgetId
| Bool
otherwise = Maybe (WidgetResult s e)
result
isCursorEvt :: SystemEvent -> Bool
isCursorEvt :: SystemEvent -> Bool
isCursorEvt Enter{} = Bool
True
isCursorEvt Click{} = Bool
True
isCursorEvt ButtonAction{} = Bool
True
isCursorEvt Move{} = Bool
True
isCursorEvt SystemEvent
_ = Bool
False