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

Helper functions for style related operations.
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

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 :: forall s e.
IsHovered s e
-> IsHovered s e -> IsHovered s e -> CurrentStyleCfg s e
CurrentStyleCfg {
    _ascIsHovered :: IsHovered s e
_ascIsHovered = IsHovered s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered,
    _ascIsFocused :: IsHovered s e
_ascIsFocused = IsHovered s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused,
    _ascIsActive :: IsHovered s e
_ascIsActive = IsHovered s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeActive
  }

-- | Extracts/copies the field of a style into an empty style.
collectStyleField
  :: Lens' StyleState (Maybe t) -- ^ The field into the state.
  -> Style                      -- ^ The source style.
  -> Style                      -- ^ The new style.
collectStyleField :: Lens' StyleState (Maybe t) -> Style -> Style
collectStyleField Lens' StyleState (Maybe t)
fieldS Style
source = Lens' StyleState (Maybe t) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ Lens' StyleState (Maybe t)
fieldS Style
source Style
forall a. Default a => a
def

-- | Extracts/copies the field of a style into a provided style.
collectStyleField_
  :: Lens' StyleState (Maybe t) -- ^ The field into the state.
  -> Style                      -- ^ The source style.
  -> Style                      -- ^ The target style.
  -> Style                      -- ^ The updated style.
collectStyleField_ :: Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ Lens' StyleState (Maybe t)
fieldS Style
source Style
target = Style
style where
  setValue :: ((Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
 -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
setValue (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
stateLens = Maybe StyleState
result where
    sourceState :: Maybe StyleState
sourceState = Style
source Style
-> ((Maybe StyleState
     -> Const (Maybe StyleState) (Maybe StyleState))
    -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
forall s a. s -> Getting a s a -> a
^. (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
stateLens
    targetState :: Maybe StyleState
targetState = Style
target Style
-> ((Maybe StyleState
     -> Const (Maybe StyleState) (Maybe StyleState))
    -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
forall s a. s -> Getting a s a -> a
^. (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
stateLens
    value :: Maybe t
value = Maybe StyleState
sourceState Maybe StyleState
-> Getting (First t) (Maybe StyleState) t -> Maybe t
forall s a. s -> Getting (First a) s a -> Maybe a
^? (StyleState -> Const (First t) StyleState)
-> Maybe StyleState -> Const (First t) (Maybe StyleState)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((StyleState -> Const (First t) StyleState)
 -> Maybe StyleState -> Const (First t) (Maybe StyleState))
-> ((t -> Const (First t) t)
    -> StyleState -> Const (First t) StyleState)
-> Getting (First t) (Maybe StyleState) t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe t -> Const (First t) (Maybe t))
-> StyleState -> Const (First t) StyleState
Lens' StyleState (Maybe t)
fieldS ((Maybe t -> Const (First t) (Maybe t))
 -> StyleState -> Const (First t) StyleState)
-> ((t -> Const (First t) t)
    -> Maybe t -> Const (First t) (Maybe t))
-> (t -> Const (First t) t)
-> StyleState
-> Const (First t) StyleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Const (First t) t) -> Maybe t -> Const (First t) (Maybe t)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
    setTarget :: t -> StyleState
setTarget t
val = Maybe StyleState
targetState Maybe StyleState
-> Getting StyleState (Maybe StyleState) StyleState -> StyleState
forall s a. s -> Getting a s a -> a
^. StyleState -> Iso' (Maybe StyleState) StyleState
forall a. Eq a => a -> Iso' (Maybe a) a
non StyleState
forall a. Default a => a
def
      StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe t -> Identity (Maybe t))
-> StyleState -> Identity StyleState
Lens' StyleState (Maybe t)
fieldS ((Maybe t -> Identity (Maybe t))
 -> StyleState -> Identity StyleState)
-> t -> StyleState -> StyleState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ t
val
    resetTarget :: StyleState
resetTarget = Maybe StyleState
targetState Maybe StyleState
-> Getting StyleState (Maybe StyleState) StyleState -> StyleState
forall s a. s -> Getting a s a -> a
^. StyleState -> Iso' (Maybe StyleState) StyleState
forall a. Eq a => a -> Iso' (Maybe a) a
non StyleState
forall a. Default a => a
def
      StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe t -> Identity (Maybe t))
-> StyleState -> Identity StyleState
Lens' StyleState (Maybe t)
fieldS ((Maybe t -> Identity (Maybe t))
 -> StyleState -> Identity StyleState)
-> Maybe t -> StyleState -> StyleState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe t
forall a. Maybe a
Nothing
    result :: Maybe StyleState
result
      | Maybe t -> Bool
forall a. Maybe a -> Bool
isJust Maybe t
value = t -> StyleState
setTarget (t -> StyleState) -> Maybe t -> Maybe StyleState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe t
value
      | Maybe StyleState -> Bool
forall a. Maybe a -> Bool
isJust Maybe StyleState
targetState = StyleState -> Maybe StyleState
forall a. a -> Maybe a
Just StyleState
resetTarget
      | Bool
otherwise = Maybe StyleState
forall a. Maybe a
Nothing

  basic :: Maybe StyleState
basic = ((Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
 -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
setValue (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
forall s a. HasBasic s a => Lens' s a
L.basic
  hover :: Maybe StyleState
hover = ((Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
 -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
setValue (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
forall s a. HasHover s a => Lens' s a
L.hover
  focus :: Maybe StyleState
focus = ((Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
 -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
setValue (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
forall s a. HasFocus s a => Lens' s a
L.focus
  focusHover :: Maybe StyleState
focusHover = ((Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
 -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
setValue (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
forall s a. HasFocusHover s a => Lens' s a
L.focusHover
  active :: Maybe StyleState
active = ((Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
 -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
setValue (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
forall s a. HasActive s a => Lens' s a
L.active
  disabled :: Maybe StyleState
disabled = ((Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
 -> Style -> Const (Maybe StyleState) Style)
-> Maybe StyleState
setValue (Maybe StyleState -> Const (Maybe StyleState) (Maybe StyleState))
-> Style -> Const (Maybe StyleState) Style
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

-- | Returns the current style state for the given node.
currentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node = CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ CurrentStyleCfg s e
forall a. Default a => a
def WidgetEnv s e
wenv WidgetNode s e
node

{-|
Returns the current style state for the given node, using the provided functions
to determine hover, focus and active status.
-}
currentStyle_
  :: CurrentStyleCfg s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ :: CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ CurrentStyleCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node = StyleState -> Maybe StyleState -> StyleState
forall a. a -> Maybe a -> a
fromMaybe StyleState
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 WidgetNode s e -> Getting Style (WidgetNode s e) Style -> Style
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Style WidgetNodeInfo)
-> WidgetNode s e -> Const Style (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Style WidgetNodeInfo)
 -> WidgetNode s e -> Const Style (WidgetNode s e))
-> ((Style -> Const Style Style)
    -> WidgetNodeInfo -> Const Style WidgetNodeInfo)
-> Getting Style (WidgetNode s e) Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Const Style Style)
-> WidgetNodeInfo -> Const Style WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.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
  isEnabled :: Bool
isEnabled = WidgetNode s e
node WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasEnabled s a => Lens' s a
L.enabled

  isHover :: Bool
isHover = CurrentStyleCfg s e -> IsHovered s e
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 = CurrentStyleCfg s e -> IsHovered s e
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 = CurrentStyleCfg s e -> IsHovered s e
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

-- | Returns the correct focused style, depending if it's hovered or not.
focusedStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle WidgetEnv s e
wenv WidgetNode s e
node = IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e.
IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle_ IsHovered s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
node

{-|
Returns the correct focused style, depending if it's hovered or not, using the
provided function.
-}
focusedStyle_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle_ IsHovered s e
isHoveredFn WidgetEnv s e
wenv WidgetNode s e
node = StyleState -> Maybe StyleState -> StyleState
forall a. a -> Maybe a -> a
fromMaybe StyleState
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 WidgetNode s e -> Getting Style (WidgetNode s e) Style -> Style
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Style WidgetNodeInfo)
-> WidgetNode s e -> Const Style (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Style WidgetNodeInfo)
 -> WidgetNode s e -> Const Style (WidgetNode s e))
-> ((Style -> Const Style Style)
    -> WidgetNodeInfo -> Const Style WidgetNodeInfo)
-> Getting Style (WidgetNode s e) Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Const Style Style)
-> WidgetNodeInfo -> Const Style WidgetNodeInfo
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

-- | Returns the current theme for the node.
currentTheme :: WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme :: WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node = IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e.
IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme_ IsHovered s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
node

-- | Returns the current theme for the node.
currentTheme_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme_ :: 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 = WidgetEnv s e -> Theme
forall s e. WidgetEnv s e -> Theme
_weTheme WidgetEnv s e
wenv
  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
  isEnabled :: Bool
isEnabled = WidgetNode s e
node WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
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 = IsHovered s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
  isActive :: Bool
isActive = IsHovered s e
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

-- | Checks if hover or focus states changed between versions of the node.
styleStateChanged :: WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
styleStateChanged :: 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
  -- Hover
  hoverChanged :: Bool
hoverChanged = SystemEvent -> Bool
isOnEnter SystemEvent
evt Bool -> Bool -> Bool
|| SystemEvent -> Bool
isOnLeave SystemEvent
evt
  -- Focus
  focusChanged :: Bool
focusChanged = SystemEvent -> Bool
isOnFocus SystemEvent
evt Bool -> Bool -> Bool
|| SystemEvent -> Bool
isOnBlur SystemEvent
evt

{-|
Initializes the node style states. Mainly, it uses basic as the base of all the
other styles.
-}
initNodeStyle
  :: GetBaseStyle s e  -- ^ The function to get the base style.
  -> WidgetEnv s e     -- ^ The widget environment.
  -> WidgetNode s e    -- ^ The widget node.
  -> WidgetNode s e    -- ^ The updated widget node.
initNodeStyle :: 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 (Style -> Style) -> Style -> Style
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node WidgetNode s e -> Getting Style (WidgetNode s e) Style -> Style
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Style WidgetNodeInfo)
-> WidgetNode s e -> Const Style (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Style WidgetNodeInfo)
 -> WidgetNode s e -> Const Style (WidgetNode s e))
-> ((Style -> Const Style Style)
    -> WidgetNodeInfo -> Const Style WidgetNodeInfo)
-> Getting Style (WidgetNode s e) Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Const Style Style)
-> WidgetNodeInfo -> Const Style WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style
  baseStyle :: Style
baseStyle = Style -> Style
mergeBasicStyle (Style -> Style) -> Style -> Style
forall a b. (a -> b) -> a -> b
$ Style -> Maybe Style -> Style
forall a. a -> Maybe a -> a
fromMaybe Style
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
    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))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Style
baseStyle Style -> Style -> Style
forall a. Semigroup a => a -> a -> a
<> Style
nodeStyle)

-- | Uses the basic style state as the base for all the other style states.
mergeBasicStyle :: Style -> Style
mergeBasicStyle :: Style -> Style
mergeBasicStyle Style
st = Style
newStyle where
  focusHover :: Maybe StyleState
focusHover = Style -> Maybe StyleState
_styleHover Style
st Maybe StyleState -> Maybe StyleState -> Maybe StyleState
forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleFocus Style
st Maybe StyleState -> Maybe StyleState -> Maybe StyleState
forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleFocusHover Style
st
  active :: Maybe StyleState
active = Maybe StyleState
focusHover Maybe StyleState -> Maybe StyleState -> Maybe StyleState
forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleActive Style
st
  newStyle :: Style
newStyle = Style :: Maybe StyleState
-> Maybe StyleState
-> Maybe StyleState
-> Maybe StyleState
-> Maybe StyleState
-> Maybe StyleState
-> Style
Style {
    _styleBasic :: Maybe StyleState
_styleBasic = Style -> Maybe StyleState
_styleBasic Style
st,
    _styleHover :: Maybe StyleState
_styleHover = Style -> Maybe StyleState
_styleBasic Style
st Maybe StyleState -> Maybe StyleState -> Maybe StyleState
forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleHover Style
st,
    _styleFocus :: Maybe StyleState
_styleFocus = Style -> Maybe StyleState
_styleBasic Style
st Maybe StyleState -> Maybe StyleState -> Maybe StyleState
forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleFocus Style
st,
    _styleFocusHover :: Maybe StyleState
_styleFocusHover = Style -> Maybe StyleState
_styleBasic Style
st Maybe StyleState -> Maybe StyleState -> Maybe StyleState
forall a. Semigroup a => a -> a -> a
<> Maybe StyleState
focusHover,
    _styleActive :: Maybe StyleState
_styleActive = Style -> Maybe StyleState
_styleBasic Style
st Maybe StyleState -> Maybe StyleState -> Maybe StyleState
forall a. Semigroup a => a -> a -> a
<> Maybe StyleState
active,
    _styleDisabled :: Maybe StyleState
_styleDisabled = Style -> Maybe StyleState
_styleBasic Style
st Maybe StyleState -> Maybe StyleState -> Maybe StyleState
forall a. Semigroup a => a -> a -> a
<> Style -> Maybe StyleState
_styleDisabled Style
st
  }

{-|
Checks for style changes between the old node and the provided result, in the
context of an event. Generates requests for resize, render and cursor change as
necessary.
-}
handleStyleChange
  :: WidgetEnv s e             -- ^ The widget environment.
  -> Path                      -- ^ The target of the event.
  -> StyleState                -- ^ The active style.
  -> Bool                      -- ^ Whether to check/update the cursor.
  -> WidgetNode s e            -- ^ The old node.
  -> SystemEvent               -- ^ The event.
  -> Maybe (WidgetResult s e)  -- ^ The result containing the new node.
  -> Maybe (WidgetResult s e)  -- ^ The updated result.
handleStyleChange :: 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 = WidgetEnv s e
-> Path
-> SystemEvent
-> WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
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 = WidgetEnv s e
-> Path
-> SystemEvent
-> StyleState
-> WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
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

{-|
Replacement of currentStyle for child widgets embedded in a focusable parent. It
selects the correct style state according to the situation.

Used, for example, in `Button` and `ExternalLink`, which are focusable but have
an embedded label. Since label is not focusable, that style would not be handled
correctly.
-}
childOfFocusedStyle
  :: WidgetEnv s e   -- ^ The widget environment.
  -> WidgetNode s e  -- ^ The embedded child node.
  -> StyleState      -- ^ The currently active state.
childOfFocusedStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
childOfFocusedStyle WidgetEnv s e
wenv WidgetNode s e
cnode = StyleState
newStyle where
  pinfo :: WidgetNodeInfo
pinfo = WidgetNodeInfo -> Maybe WidgetNodeInfo -> WidgetNodeInfo
forall a. a -> Maybe a -> a
fromMaybe WidgetNodeInfo
forall a. Default a => a
def (WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Path -> Maybe WidgetNodeInfo)
     (WidgetEnv s e)
     (Path -> Maybe WidgetNodeInfo)
-> Path
-> Maybe WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting
  (Path -> Maybe WidgetNodeInfo)
  (WidgetEnv s e)
  (Path -> Maybe WidgetNodeInfo)
forall s a. HasFindByPath s a => Lens' s a
L.findByPath (Path -> Maybe WidgetNodeInfo) -> Path -> Maybe WidgetNodeInfo
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> Path
forall s e. WidgetNode s e -> Path
parentPath WidgetNode s e
cnode)
  cstyle :: Style
cstyle = WidgetNode s e
cnode WidgetNode s e -> Getting Style (WidgetNode s e) Style -> Style
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Style WidgetNodeInfo)
-> WidgetNode s e -> Const Style (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Style WidgetNodeInfo)
 -> WidgetNode s e -> Const Style (WidgetNode s e))
-> ((Style -> Const Style Style)
    -> WidgetNodeInfo -> Const Style WidgetNodeInfo)
-> Getting Style (WidgetNode s e) Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Const Style Style)
-> WidgetNodeInfo -> Const Style WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style
  enabled :: Bool
enabled = WidgetNode s e
cnode WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasEnabled s a => Lens' s a
L.enabled

  activeC :: Bool
activeC = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeActive WidgetEnv s e
wenv WidgetNode s e
cnode
  activeP :: Bool
activeP = Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
forall s e. Bool -> WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoActive Bool
False WidgetEnv s e
wenv WidgetNodeInfo
pinfo

  hoverC :: Bool
hoverC = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered WidgetEnv s e
wenv WidgetNode s e
cnode
  hoverP :: Bool
hoverP = WidgetEnv s e -> WidgetNodeInfo -> Bool
forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoHovered WidgetEnv s e
wenv WidgetNodeInfo
pinfo
  focusP :: Bool
focusP = WidgetEnv s e -> WidgetNodeInfo -> Bool
forall s e. WidgetEnv s e -> WidgetNodeInfo -> Bool
isNodeInfoFocused WidgetEnv s e
wenv WidgetNodeInfo
pinfo

  newStyle :: StyleState
newStyle
    | Bool -> Bool
not Bool
enabled = StyleState -> Maybe StyleState -> StyleState
forall a. a -> Maybe a -> a
fromMaybe StyleState
forall a. Default a => a
def (Style -> Maybe StyleState
_styleDisabled Style
cstyle)
    | Bool
activeC Bool -> Bool -> Bool
|| Bool
activeP = StyleState -> Maybe StyleState -> StyleState
forall a. a -> Maybe a -> a
fromMaybe StyleState
forall a. Default a => a
def (Style -> Maybe StyleState
_styleActive Style
cstyle)
    | (Bool
hoverC Bool -> Bool -> Bool
|| Bool
hoverP) Bool -> Bool -> Bool
&& Bool
focusP = StyleState -> Maybe StyleState -> StyleState
forall a. a -> Maybe a -> a
fromMaybe StyleState
forall a. Default a => a
def (Style -> Maybe StyleState
_styleFocusHover Style
cstyle)
    | Bool
hoverC Bool -> Bool -> Bool
|| Bool
hoverP = StyleState -> Maybe StyleState -> StyleState
forall a. a -> Maybe a -> a
fromMaybe StyleState
forall a. Default a => a
def (Style -> Maybe StyleState
_styleHover Style
cstyle)
    | Bool
focusP = StyleState -> Maybe StyleState -> StyleState
forall a. a -> Maybe a -> a
fromMaybe StyleState
forall a. Default a => a
def (Style -> Maybe StyleState
_styleFocus Style
cstyle)
    | 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
cnode

-- Helpers
handleSizeChange
  :: WidgetEnv s e
  -> Path
  -> SystemEvent
  -> WidgetNode s e
  -> Maybe (WidgetResult s e)
  -> Maybe (WidgetResult s e)
handleSizeChange :: 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 = WidgetResult s e -> Maybe (WidgetResult s e) -> WidgetResult s e
forall a. a -> Maybe a -> a
fromMaybe (WidgetNode s e -> WidgetResult s e
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 WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node
  widgetId :: WidgetId
widgetId = WidgetNode s e
newNode WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
  path :: Path
path = WidgetNode s e
newNode WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
  -- Size
  oldSizeReqW :: SizeReq
oldSizeReqW = WidgetNode s e
oldNode 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
  oldSizeReqH :: SizeReq
oldSizeReqH = WidgetNode s e
oldNode 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
  newSizeReqW :: SizeReq
newSizeReqW = WidgetNode s e
newNode 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
  newSizeReqH :: SizeReq
newSizeReqH = WidgetNode s e
newNode 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
  sizeReqChanged :: Bool
sizeReqChanged = SizeReq
oldSizeReqW SizeReq -> SizeReq -> Bool
forall a. Eq a => a -> a -> Bool
/= SizeReq
newSizeReqW Bool -> Bool -> Bool
|| SizeReq
oldSizeReqH SizeReq -> SizeReq -> Bool
forall a. Eq a => a -> a -> Bool
/= SizeReq
newSizeReqH
  -- Hover drag changed (if dragging, Enter/Leave is not sent)
  prevInVp :: Bool
prevInVp = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
newNode (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)
  currInVp :: Bool
currInVp = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
newNode (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)
  pressedPath :: Maybe Path
pressedPath = WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Maybe (Path, Point)) (WidgetEnv s e) (Maybe (Path, Point))
-> Maybe (Path, Point)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Path, Point)) (WidgetEnv s e) (Maybe (Path, Point))
forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress Maybe (Path, Point)
-> Getting (First Path) (Maybe (Path, Point)) Path -> Maybe Path
forall s a. s -> Getting (First a) s a -> Maybe a
^? ((Path, Point) -> Const (First Path) (Path, Point))
-> Maybe (Path, Point) -> Const (First Path) (Maybe (Path, Point))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((Path, Point) -> Const (First Path) (Path, Point))
 -> Maybe (Path, Point) -> Const (First Path) (Maybe (Path, Point)))
-> ((Path -> Const (First Path) Path)
    -> (Path, Point) -> Const (First Path) (Path, Point))
-> Getting (First Path) (Maybe (Path, Point)) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (First Path) Path)
-> (Path, Point) -> Const (First Path) (Path, Point)
forall s t a b. Field1 s t a b => Lens s t a b
_1
  hoverDragChg :: Bool
hoverDragChg = Path -> Maybe Path
forall a. a -> Maybe a
Just Path
path Maybe Path -> Maybe Path -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Path
pressedPath Bool -> Bool -> Bool
&& Bool
prevInVp Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
currInVp
  -- Result
  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 = [ WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId | Bool
sizeReqChanged ]
  enterReq :: [WidgetRequest s e]
enterReq = [ WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce | Bool
renderReq ]
  reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
forall s e. [WidgetRequest s e]
resizeReq [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall s e. [WidgetRequest s e]
enterReq
  newResult :: Maybe (WidgetResult s e)
newResult
    | Bool -> Bool
not ([WidgetRequest Any Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest Any Any]
forall s e. [WidgetRequest s e]
reqs) = 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
baseResult
      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]
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 :: 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 = WidgetResult s e -> Maybe (WidgetResult s e) -> WidgetResult s e
forall a. a -> Maybe a -> a
fromMaybe (WidgetNode s e -> WidgetResult s e
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 WidgetResult s e
-> Getting
     (Seq (WidgetRequest s e))
     (WidgetResult s e)
     (Seq (WidgetRequest s e))
-> Seq (WidgetRequest s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetRequest s e))
  (WidgetResult s e)
  (Seq (WidgetRequest s e))
forall s a. HasRequests s a => Lens' s a
L.requests
  node :: WidgetNode s e
node = WidgetResult s e
baseResult WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node
  -- Cursor
  widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
  path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
  isTarget :: Bool
isTarget = Path
path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
target
  hasCursor :: Bool
hasCursor = Maybe CursorIcon -> Bool
forall a. Maybe a -> Bool
isJust (StyleState
style StyleState
-> Getting (Maybe CursorIcon) StyleState (Maybe CursorIcon)
-> Maybe CursorIcon
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CursorIcon) StyleState (Maybe CursorIcon)
forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon)
  isPressed :: Bool
isPressed = 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
node
  (Path
curPath, CursorIcon
curIcon) = (Path, CursorIcon)
-> Maybe (Path, CursorIcon) -> (Path, CursorIcon)
forall a. a -> Maybe a -> a
fromMaybe (Path, CursorIcon)
forall a. Default a => a
def (WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Maybe (Path, CursorIcon))
     (WidgetEnv s e)
     (Maybe (Path, CursorIcon))
-> Maybe (Path, CursorIcon)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Path, CursorIcon))
  (WidgetEnv s e)
  (Maybe (Path, CursorIcon))
forall s a. HasCursor s a => Lens' s a
L.cursor)
  isParent :: Bool
isParent = Path -> Path -> Bool
forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
path Path
curPath Bool -> Bool -> Bool
&& Path
path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
curPath
  newIcon :: CursorIcon
newIcon = CursorIcon -> Maybe CursorIcon -> CursorIcon
forall a. a -> Maybe a -> a
fromMaybe CursorIcon
CursorArrow (StyleState
style StyleState
-> Getting (Maybe CursorIcon) StyleState (Maybe CursorIcon)
-> Maybe CursorIcon
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CursorIcon) StyleState (Maybe CursorIcon)
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 CursorIcon -> CursorIcon -> Bool
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 Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
path
  -- Result
  newResult :: Maybe (WidgetResult s e)
newResult
    | Bool
setCursor = 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
baseResult
      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 s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
newIcon WidgetRequest s e
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. a -> Seq a -> Seq a
<| Seq (WidgetRequest s e)
baseReqs
    | Bool
resetCursor = 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
baseResult
      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 s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetRequest s e)
baseReqs Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetId -> WidgetRequest s e
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