{-|
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 #-}
{-# 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 :: 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 "Monomer.Widgets.Singles.Button" and
"Monomer.Widgets.Singles.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
  branch :: Seq WidgetNodeInfo
branch = WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Path -> Seq WidgetNodeInfo)
     (WidgetEnv s e)
     (Path -> Seq WidgetNodeInfo)
-> Path
-> Seq WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting
  (Path -> Seq WidgetNodeInfo)
  (WidgetEnv s e)
  (Path -> Seq WidgetNodeInfo)
forall s a. HasFindBranchByPath s a => Lens' s a
L.findBranchByPath (Path -> Seq WidgetNodeInfo) -> Path -> Seq WidgetNodeInfo
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> Path
forall s e. WidgetNode s e -> Path
parentPath WidgetNode s e
cnode
  pinfo :: WidgetNodeInfo
pinfo = WidgetNodeInfo -> Maybe WidgetNodeInfo -> WidgetNodeInfo
forall a. a -> Maybe a -> a
fromMaybe WidgetNodeInfo
forall a. Default a => a
def (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)
  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