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

Scroll container of a single node. Assigns all the space the inner node requests
but limits itself to what its parent assigns. It allows navigating the content
of the inner node with the scroll bars. It also supports automatic focus
following.

Messages:

- 'ScrollTo': Causes the scroll to update its handles to ensure rect is visible.
- 'ScrollReset': Sets both handle positions to zero.
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Monomer.Widgets.Containers.Scroll (
  -- * Configuration
  ScrollCfg,
  ScrollMessage(..),
  scrollOverlay,
  scrollOverlay_,
  scrollFwdStyle,
  scrollFwdDefault,
  scrollInvisible,
  scrollInvisible_,
  scrollFollowFocus,
  scrollFollowFocus_,
  scrollStyle,
  -- * Constructors
  scroll,
  scroll_,
  hscroll,
  hscroll_,
  vscroll,
  vscroll_
) where

import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (.~), (^?), (^?!), (<>~), (%~), _Just, cloneLens, ix)
import Control.Monad
import Data.Default
import Data.Maybe
import Data.Typeable (cast)
import GHC.Generics

import qualified Data.Sequence as Seq

import Monomer.Helper
import Monomer.Widgets.Container

import qualified Monomer.Lens as L

data ScrollType
  = ScrollH
  | ScrollV
  | ScrollBoth
  deriving (ScrollType -> ScrollType -> Bool
(ScrollType -> ScrollType -> Bool)
-> (ScrollType -> ScrollType -> Bool) -> Eq ScrollType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollType -> ScrollType -> Bool
$c/= :: ScrollType -> ScrollType -> Bool
== :: ScrollType -> ScrollType -> Bool
$c== :: ScrollType -> ScrollType -> Bool
Eq, Int -> ScrollType -> ShowS
[ScrollType] -> ShowS
ScrollType -> String
(Int -> ScrollType -> ShowS)
-> (ScrollType -> String)
-> ([ScrollType] -> ShowS)
-> Show ScrollType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollType] -> ShowS
$cshowList :: [ScrollType] -> ShowS
show :: ScrollType -> String
$cshow :: ScrollType -> String
showsPrec :: Int -> ScrollType -> ShowS
$cshowsPrec :: Int -> ScrollType -> ShowS
Show)

data ActiveBar
  = HBar
  | VBar
  deriving (ActiveBar -> ActiveBar -> Bool
(ActiveBar -> ActiveBar -> Bool)
-> (ActiveBar -> ActiveBar -> Bool) -> Eq ActiveBar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveBar -> ActiveBar -> Bool
$c/= :: ActiveBar -> ActiveBar -> Bool
== :: ActiveBar -> ActiveBar -> Bool
$c== :: ActiveBar -> ActiveBar -> Bool
Eq, Int -> ActiveBar -> ShowS
[ActiveBar] -> ShowS
ActiveBar -> String
(Int -> ActiveBar -> ShowS)
-> (ActiveBar -> String)
-> ([ActiveBar] -> ShowS)
-> Show ActiveBar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveBar] -> ShowS
$cshowList :: [ActiveBar] -> ShowS
show :: ActiveBar -> String
$cshow :: ActiveBar -> String
showsPrec :: Int -> ActiveBar -> ShowS
$cshowsPrec :: Int -> ActiveBar -> ShowS
Show, (forall x. ActiveBar -> Rep ActiveBar x)
-> (forall x. Rep ActiveBar x -> ActiveBar) -> Generic ActiveBar
forall x. Rep ActiveBar x -> ActiveBar
forall x. ActiveBar -> Rep ActiveBar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActiveBar x -> ActiveBar
$cfrom :: forall x. ActiveBar -> Rep ActiveBar x
Generic)

{-|
Configuration options for scroll:

- 'wheelRate': rate at which wheel movement causes scrolling.
- 'barColor': the color of the bar (container of the thumb).
- 'barHoverColor': the color of the bar when mouse is on top.
- 'barWidth': the width of the bar.
- 'thumbColor': the color of the thumb.
- 'thumbHoverColor': the color of the thumb when mouse is on top.
- 'thumbWidth': the width of the thumb.
- 'thumbRadius': the radius of the corners of the thumb.
- 'scrollOverlay': whether scroll bar should be on top of content or by the
  side.
- 'scrollInvisible': shortcut for setting invisible style. Useful with scroll
  overlay, since it allows scrolling without taking up space or hiding content.
- 'scrollFollowFocus': whether to auto scroll when focusing a non visible item.
- 'scrollStyle': the base style of the scroll bar.
-}
data ScrollCfg s e = ScrollCfg {
  ScrollCfg s e -> Maybe ScrollType
_scScrollType :: Maybe ScrollType,
  ScrollCfg s e -> Maybe Bool
_scScrollOverlay :: Maybe Bool,
  ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style)),
  ScrollCfg s e -> Maybe Bool
_scFollowFocus :: Maybe Bool,
  ScrollCfg s e -> Maybe Rational
_scWheelRate :: Maybe Rational,
  ScrollCfg s e -> Maybe Color
_scBarColor :: Maybe Color,
  ScrollCfg s e -> Maybe Color
_scBarHoverColor :: Maybe Color,
  ScrollCfg s e -> Maybe Color
_scThumbColor :: Maybe Color,
  ScrollCfg s e -> Maybe Color
_scThumbHoverColor :: Maybe Color,
  ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle :: Maybe (ALens' ThemeState StyleState),
  ScrollCfg s e -> Maybe Double
_scBarWidth :: Maybe Double,
  ScrollCfg s e -> Maybe Double
_scThumbWidth :: Maybe Double,
  ScrollCfg s e -> Maybe Double
_scThumbRadius :: Maybe Double
}

instance Default (ScrollCfg s e) where
  def :: ScrollCfg s e
def = ScrollCfg :: forall s e.
Maybe ScrollType
-> Maybe Bool
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe Bool
-> Maybe Rational
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe (ALens' ThemeState StyleState)
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> ScrollCfg s e
ScrollCfg {
    _scScrollType :: Maybe ScrollType
_scScrollType = Maybe ScrollType
forall a. Maybe a
Nothing,
    _scScrollOverlay :: Maybe Bool
_scScrollOverlay = Maybe Bool
forall a. Maybe a
Nothing,
    _scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle = Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall a. Maybe a
Nothing,
    _scFollowFocus :: Maybe Bool
_scFollowFocus = Maybe Bool
forall a. Maybe a
Nothing,
    _scWheelRate :: Maybe Rational
_scWheelRate = Maybe Rational
forall a. Maybe a
Nothing,
    _scBarColor :: Maybe Color
_scBarColor = Maybe Color
forall a. Maybe a
Nothing,
    _scBarHoverColor :: Maybe Color
_scBarHoverColor = Maybe Color
forall a. Maybe a
Nothing,
    _scThumbColor :: Maybe Color
_scThumbColor = Maybe Color
forall a. Maybe a
Nothing,
    _scThumbHoverColor :: Maybe Color
_scThumbHoverColor = Maybe Color
forall a. Maybe a
Nothing,
    _scStyle :: Maybe (ALens' ThemeState StyleState)
_scStyle = Maybe (ALens' ThemeState StyleState)
forall a. Maybe a
Nothing,
    _scBarWidth :: Maybe Double
_scBarWidth = Maybe Double
forall a. Maybe a
Nothing,
    _scThumbWidth :: Maybe Double
_scThumbWidth = Maybe Double
forall a. Maybe a
Nothing,
    _scThumbRadius :: Maybe Double
_scThumbRadius = Maybe Double
forall a. Maybe a
Nothing
  }

instance Semigroup (ScrollCfg s e) where
  <> :: ScrollCfg s e -> ScrollCfg s e -> ScrollCfg s e
(<>) ScrollCfg s e
t1 ScrollCfg s e
t2 = ScrollCfg :: forall s e.
Maybe ScrollType
-> Maybe Bool
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe Bool
-> Maybe Rational
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe (ALens' ThemeState StyleState)
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> ScrollCfg s e
ScrollCfg {
    _scScrollType :: Maybe ScrollType
_scScrollType = ScrollCfg s e -> Maybe ScrollType
forall s e. ScrollCfg s e -> Maybe ScrollType
_scScrollType ScrollCfg s e
t2 Maybe ScrollType -> Maybe ScrollType -> Maybe ScrollType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe ScrollType
forall s e. ScrollCfg s e -> Maybe ScrollType
_scScrollType ScrollCfg s e
t1,
    _scScrollOverlay :: Maybe Bool
_scScrollOverlay = ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay ScrollCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay ScrollCfg s e
t1,
    _scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle = ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall s e.
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle ScrollCfg s e
t2 Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall s e.
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle ScrollCfg s e
t1,
    _scFollowFocus :: Maybe Bool
_scFollowFocus = ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scFollowFocus ScrollCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scFollowFocus ScrollCfg s e
t1,
    _scWheelRate :: Maybe Rational
_scWheelRate = ScrollCfg s e -> Maybe Rational
forall s e. ScrollCfg s e -> Maybe Rational
_scWheelRate ScrollCfg s e
t2 Maybe Rational -> Maybe Rational -> Maybe Rational
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Rational
forall s e. ScrollCfg s e -> Maybe Rational
_scWheelRate ScrollCfg s e
t1,
    _scBarColor :: Maybe Color
_scBarColor = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarColor ScrollCfg s e
t2 Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarColor ScrollCfg s e
t1,
    _scBarHoverColor :: Maybe Color
_scBarHoverColor = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarHoverColor ScrollCfg s e
t2 Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarHoverColor ScrollCfg s e
t1,
    _scThumbColor :: Maybe Color
_scThumbColor = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbColor ScrollCfg s e
t2 Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbColor ScrollCfg s e
t1,
    _scThumbHoverColor :: Maybe Color
_scThumbHoverColor = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbHoverColor ScrollCfg s e
t2 Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbHoverColor ScrollCfg s e
t1,
    _scStyle :: Maybe (ALens' ThemeState StyleState)
_scStyle = ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
forall s e. ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle ScrollCfg s e
t2 Maybe (ALens' ThemeState StyleState)
-> Maybe (ALens' ThemeState StyleState)
-> Maybe (ALens' ThemeState StyleState)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
forall s e. ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle ScrollCfg s e
t1,
    _scBarWidth :: Maybe Double
_scBarWidth = ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
t1,
    _scThumbWidth :: Maybe Double
_scThumbWidth = ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbWidth ScrollCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbWidth ScrollCfg s e
t1,
    _scThumbRadius :: Maybe Double
_scThumbRadius = ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbRadius ScrollCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbRadius ScrollCfg s e
t1
  }

instance Monoid (ScrollCfg s e) where
  mempty :: ScrollCfg s e
mempty = ScrollCfg s e
forall a. Default a => a
def

instance CmbWheelRate (ScrollCfg s e) Rational where
  wheelRate :: Rational -> ScrollCfg s e
wheelRate Rational
rate = ScrollCfg s e
forall a. Default a => a
def {
    _scWheelRate :: Maybe Rational
_scWheelRate = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
rate
  }

instance CmbBarColor (ScrollCfg s e) where
  barColor :: Color -> ScrollCfg s e
barColor Color
col = ScrollCfg s e
forall a. Default a => a
def {
    _scBarColor :: Maybe Color
_scBarColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col
  }

instance CmbBarHoverColor (ScrollCfg s e) where
  barHoverColor :: Color -> ScrollCfg s e
barHoverColor Color
col = ScrollCfg s e
forall a. Default a => a
def {
    _scBarHoverColor :: Maybe Color
_scBarHoverColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col
  }

instance CmbBarWidth (ScrollCfg s e) where
  barWidth :: Double -> ScrollCfg s e
barWidth Double
w = ScrollCfg s e
forall a. Default a => a
def {
    _scBarWidth :: Maybe Double
_scBarWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
  }

-- Thumb
instance CmbThumbColor (ScrollCfg s e) where
  thumbColor :: Color -> ScrollCfg s e
thumbColor Color
col = ScrollCfg s e
forall a. Default a => a
def {
    _scThumbColor :: Maybe Color
_scThumbColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col
  }

instance CmbThumbHoverColor (ScrollCfg s e) where
  thumbHoverColor :: Color -> ScrollCfg s e
thumbHoverColor Color
col = ScrollCfg s e
forall a. Default a => a
def {
    _scThumbHoverColor :: Maybe Color
_scThumbHoverColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col
  }

instance CmbThumbWidth (ScrollCfg s e) where
  thumbWidth :: Double -> ScrollCfg s e
thumbWidth Double
w = ScrollCfg s e
forall a. Default a => a
def {
    _scThumbWidth :: Maybe Double
_scThumbWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
  }

instance CmbThumbRadius (ScrollCfg s e) where
  thumbRadius :: Double -> ScrollCfg s e
thumbRadius Double
r = ScrollCfg s e
forall a. Default a => a
def {
    _scThumbRadius :: Maybe Double
_scThumbRadius = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
r
  }

-- | Scroll bars will be displayed on top of the content.
scrollOverlay :: ScrollCfg s e
scrollOverlay :: ScrollCfg s e
scrollOverlay = Bool -> ScrollCfg s e
forall s e. Bool -> ScrollCfg s e
scrollOverlay_ Bool
True

{-|
Sets whether scroll bars will be displayed on top of the content or next to it.
-}
scrollOverlay_ :: Bool -> ScrollCfg s e
scrollOverlay_ :: Bool -> ScrollCfg s e
scrollOverlay_ Bool
overlay = ScrollCfg s e
forall a. Default a => a
def {
  _scScrollOverlay :: Maybe Bool
_scScrollOverlay = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
overlay
}

{-|
Sets a function that will split the node's style into one for the scroll and one
for the child node. Useful for widgets which wrap themselves in a scroll, such
as textArea, to be able to receive customizations made by the user.
-}
scrollFwdStyle :: (WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
scrollFwdStyle :: (WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
scrollFwdStyle WidgetEnv s e -> Style -> (Style, Style)
fwd = ScrollCfg Any Any
forall a. Default a => a
def {
  _scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle = (WidgetEnv s e -> Style -> (Style, Style))
-> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall a. a -> Maybe a
Just WidgetEnv s e -> Style -> (Style, Style)
fwd
}

-- | Default style forward function, keeping standard fields for scroll.
scrollFwdDefault :: WidgetEnv s e -> Style -> (Style, Style)
scrollFwdDefault :: WidgetEnv s e -> Style -> (Style, Style)
scrollFwdDefault WidgetEnv s e
wenv Style
style = (Style
scrollStyle, Style
childStyle) where
  scrollStyle :: Style
scrollStyle = Style
forall a. Default a => a
def
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe SizeReq) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSizeReqW s a => Lens' s a
Lens' StyleState (Maybe SizeReq)
L.sizeReqW Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe SizeReq) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSizeReqH s a => Lens' s a
Lens' StyleState (Maybe SizeReq)
L.sizeReqH Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Border) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasBorder s a => Lens' s a
Lens' StyleState (Maybe Border)
L.border Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Radius) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasRadius s a => Lens' s a
Lens' StyleState (Maybe Radius)
L.radius Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Color) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasBgColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.bgColor Style
style
  childStyle :: Style
childStyle = Style
forall a. Default a => a
def
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Padding) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasPadding s a => Lens' s a
Lens' StyleState (Maybe Padding)
L.padding Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Color) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasFgColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.fgColor Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Color) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSndColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.sndColor Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe Color) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasHlColor s a => Lens' s a
Lens' StyleState (Maybe Color)
L.hlColor Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe TextStyle) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasText s a => Lens' s a
Lens' StyleState (Maybe TextStyle)
L.text Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Lens' StyleState (Maybe CursorIcon) -> Style -> Style -> Style
forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasCursorIcon s a => Lens' s a
Lens' StyleState (Maybe CursorIcon)
L.cursorIcon Style
style

-- | Sets the style of the scroll bars to transparent.
scrollInvisible :: ScrollCfg s e
scrollInvisible :: ScrollCfg s e
scrollInvisible = Bool -> ScrollCfg s e
forall s e. Bool -> ScrollCfg s e
scrollInvisible_ Bool
True

-- | Whether to set the style of the scroll bars to transparent.
scrollInvisible_ :: Bool -> ScrollCfg s e
scrollInvisible_ :: Bool -> ScrollCfg s e
scrollInvisible_ Bool
False = ScrollCfg s e
forall a. Default a => a
def
scrollInvisible_ Bool
True = ScrollCfg s e
forall a. Default a => a
def {
  _scScrollOverlay :: Maybe Bool
_scScrollOverlay = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
  _scBarColor :: Maybe Color
_scBarColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
transparent,
  _scBarHoverColor :: Maybe Color
_scBarHoverColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
transparent,
  _scThumbColor :: Maybe Color
_scThumbColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
transparent,
  _scThumbHoverColor :: Maybe Color
_scThumbHoverColor = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
transparent
}

-- | Makes the scroll automatically follow focused items to make them visible.
scrollFollowFocus :: ScrollCfg s e
scrollFollowFocus :: ScrollCfg s e
scrollFollowFocus = Bool -> ScrollCfg s e
forall s e. Bool -> ScrollCfg s e
scrollFollowFocus_ Bool
True

-- | Whether to automatically follow focused items to make them visible.
scrollFollowFocus_ :: Bool -> ScrollCfg s e
scrollFollowFocus_ :: Bool -> ScrollCfg s e
scrollFollowFocus_ Bool
follow = ScrollCfg s e
forall a. Default a => a
def {
  _scFollowFocus :: Maybe Bool
_scFollowFocus = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
follow
}

{-|
Sets the base style of the scroll bar. Useful when creating widgets which use
scroll and may need to customize it.
-}
scrollStyle :: ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle :: ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle ALens' ThemeState StyleState
style = ScrollCfg s e
forall a. Default a => a
def {
  _scStyle :: Maybe (ALens' ThemeState StyleState)
_scStyle = ALens' ThemeState StyleState
-> Maybe (ALens' ThemeState StyleState)
forall a. a -> Maybe a
Just ALens' ThemeState StyleState
style
}

-- Not exported
scrollType :: ScrollType -> ScrollCfg s e
scrollType :: ScrollType -> ScrollCfg s e
scrollType ScrollType
st = ScrollCfg s e
forall a. Default a => a
def {
  _scScrollType :: Maybe ScrollType
_scScrollType = ScrollType -> Maybe ScrollType
forall a. a -> Maybe a
Just ScrollType
st
}

data ScrollState = ScrollState {
  ScrollState -> Maybe ActiveBar
_sstDragging :: Maybe ActiveBar,
  ScrollState -> Double
_sstDeltaX :: !Double,
  ScrollState -> Double
_sstDeltaY :: !Double,
  ScrollState -> Size
_sstVpSize :: Size,
  ScrollState -> Size
_sstChildSize :: Size,
  ScrollState -> Rect
_sstScissor :: Rect
} deriving (ScrollState -> ScrollState -> Bool
(ScrollState -> ScrollState -> Bool)
-> (ScrollState -> ScrollState -> Bool) -> Eq ScrollState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollState -> ScrollState -> Bool
$c/= :: ScrollState -> ScrollState -> Bool
== :: ScrollState -> ScrollState -> Bool
$c== :: ScrollState -> ScrollState -> Bool
Eq, Int -> ScrollState -> ShowS
[ScrollState] -> ShowS
ScrollState -> String
(Int -> ScrollState -> ShowS)
-> (ScrollState -> String)
-> ([ScrollState] -> ShowS)
-> Show ScrollState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollState] -> ShowS
$cshowList :: [ScrollState] -> ShowS
show :: ScrollState -> String
$cshow :: ScrollState -> String
showsPrec :: Int -> ScrollState -> ShowS
$cshowsPrec :: Int -> ScrollState -> ShowS
Show, (forall x. ScrollState -> Rep ScrollState x)
-> (forall x. Rep ScrollState x -> ScrollState)
-> Generic ScrollState
forall x. Rep ScrollState x -> ScrollState
forall x. ScrollState -> Rep ScrollState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScrollState x -> ScrollState
$cfrom :: forall x. ScrollState -> Rep ScrollState x
Generic)

data ScrollContext = ScrollContext {
  ScrollContext -> Double
hScrollRatio :: Double,
  ScrollContext -> Double
vScrollRatio :: Double,
  ScrollContext -> Bool
hScrollRequired :: Bool,
  ScrollContext -> Bool
vScrollRequired :: Bool,
  ScrollContext -> Bool
hMouseInScroll :: Bool,
  ScrollContext -> Bool
vMouseInScroll :: Bool,
  ScrollContext -> Bool
hMouseInThumb :: Bool,
  ScrollContext -> Bool
vMouseInThumb :: Bool,
  ScrollContext -> Rect
hScrollRect :: Rect,
  ScrollContext -> Rect
vScrollRect :: Rect,
  ScrollContext -> Rect
hThumbRect :: Rect,
  ScrollContext -> Rect
vThumbRect :: Rect
} deriving (ScrollContext -> ScrollContext -> Bool
(ScrollContext -> ScrollContext -> Bool)
-> (ScrollContext -> ScrollContext -> Bool) -> Eq ScrollContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollContext -> ScrollContext -> Bool
$c/= :: ScrollContext -> ScrollContext -> Bool
== :: ScrollContext -> ScrollContext -> Bool
$c== :: ScrollContext -> ScrollContext -> Bool
Eq, Int -> ScrollContext -> ShowS
[ScrollContext] -> ShowS
ScrollContext -> String
(Int -> ScrollContext -> ShowS)
-> (ScrollContext -> String)
-> ([ScrollContext] -> ShowS)
-> Show ScrollContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollContext] -> ShowS
$cshowList :: [ScrollContext] -> ShowS
show :: ScrollContext -> String
$cshow :: ScrollContext -> String
showsPrec :: Int -> ScrollContext -> ShowS
$cshowsPrec :: Int -> ScrollContext -> ShowS
Show)

instance Default ScrollState where
  def :: ScrollState
def = ScrollState :: Maybe ActiveBar
-> Double -> Double -> Size -> Size -> Rect -> ScrollState
ScrollState {
    _sstDragging :: Maybe ActiveBar
_sstDragging = Maybe ActiveBar
forall a. Maybe a
Nothing,
    _sstDeltaX :: Double
_sstDeltaX = Double
0,
    _sstDeltaY :: Double
_sstDeltaY = Double
0,
    _sstVpSize :: Size
_sstVpSize = Size
forall a. Default a => a
def,
    _sstChildSize :: Size
_sstChildSize = Size
forall a. Default a => a
def,
    _sstScissor :: Rect
_sstScissor = Rect
forall a. Default a => a
def
  }

-- | Messages the scroll component supports.
data ScrollMessage
  -- | Causes the scroll to update its bars to ensure rect is visible.
  = ScrollTo Rect
  -- | Sets both bars to zero.
  | ScrollReset
  deriving (ScrollMessage -> ScrollMessage -> Bool
(ScrollMessage -> ScrollMessage -> Bool)
-> (ScrollMessage -> ScrollMessage -> Bool) -> Eq ScrollMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollMessage -> ScrollMessage -> Bool
$c/= :: ScrollMessage -> ScrollMessage -> Bool
== :: ScrollMessage -> ScrollMessage -> Bool
$c== :: ScrollMessage -> ScrollMessage -> Bool
Eq, Int -> ScrollMessage -> ShowS
[ScrollMessage] -> ShowS
ScrollMessage -> String
(Int -> ScrollMessage -> ShowS)
-> (ScrollMessage -> String)
-> ([ScrollMessage] -> ShowS)
-> Show ScrollMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollMessage] -> ShowS
$cshowList :: [ScrollMessage] -> ShowS
show :: ScrollMessage -> String
$cshow :: ScrollMessage -> String
showsPrec :: Int -> ScrollMessage -> ShowS
$cshowsPrec :: Int -> ScrollMessage -> ShowS
Show)

-- | Creates a scroll node that may show both bars.
scroll :: WidgetNode s e -> WidgetNode s e
scroll :: WidgetNode s e -> WidgetNode s e
scroll WidgetNode s e
managedWidget = [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [ScrollCfg s e]
forall a. Default a => a
def WidgetNode s e
managedWidget

-- | Creates a scroll node that may show both bars. Accepts config.
scroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [ScrollCfg s e]
configs WidgetNode s e
managed = Widget s e -> WidgetNode s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
forall a. Default a => a
def) WidgetNode s e
managed where
  config :: ScrollCfg s e
config = [ScrollCfg s e] -> ScrollCfg s e
forall a. Monoid a => [a] -> a
mconcat [ScrollCfg s e]
configs

-- | Creates a horizontal scroll node. Vertical space is equal to what the
--   parent node assigns.
hscroll :: WidgetNode s e -> WidgetNode s e
hscroll :: WidgetNode s e -> WidgetNode s e
hscroll WidgetNode s e
managedWidget = [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
hscroll_ [ScrollCfg s e]
forall a. Default a => a
def WidgetNode s e
managedWidget

-- | Creates a horizontal scroll node. Vertical space is equal to what the
--   parent node assigns. Accepts config.
hscroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
hscroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
hscroll_ [ScrollCfg s e]
configs WidgetNode s e
managed = Widget s e -> WidgetNode s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
forall a. Default a => a
def) WidgetNode s e
managed where
  config :: ScrollCfg s e
config = [ScrollCfg s e] -> ScrollCfg s e
forall a. Monoid a => [a] -> a
mconcat (ScrollType -> ScrollCfg s e
forall s e. ScrollType -> ScrollCfg s e
scrollType ScrollType
ScrollH ScrollCfg s e -> [ScrollCfg s e] -> [ScrollCfg s e]
forall a. a -> [a] -> [a]
: [ScrollCfg s e]
configs)

-- | Creates a vertical scroll node. Vertical space is equal to what the
--   parent node assigns.
vscroll :: WidgetNode s e -> WidgetNode s e
vscroll :: WidgetNode s e -> WidgetNode s e
vscroll WidgetNode s e
managedWidget = [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
vscroll_ [ScrollCfg s e]
forall a. Default a => a
def WidgetNode s e
managedWidget

-- | Creates a vertical scroll node. Vertical space is equal to what the
--   parent node assigns. Accepts config.
vscroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
vscroll_ :: [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
vscroll_ [ScrollCfg s e]
configs WidgetNode s e
managed = Widget s e -> WidgetNode s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
forall a. Default a => a
def) WidgetNode s e
managed where
  config :: ScrollCfg s e
config = [ScrollCfg s e] -> ScrollCfg s e
forall a. Monoid a => [a] -> a
mconcat (ScrollType -> ScrollCfg s e
forall s e. ScrollType -> ScrollCfg s e
scrollType ScrollType
ScrollV ScrollCfg s e -> [ScrollCfg s e] -> [ScrollCfg s e]
forall a. a -> [a] -> [a]
: [ScrollCfg s e]
configs)

makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
managedWidget = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"scroll" Widget s e
widget
  WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
  WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNode s e -> Seq (WidgetNode s e)
forall a. a -> Seq a
Seq.singleton WidgetNode s e
managedWidget

makeScroll :: ScrollCfg s e -> ScrollState -> Widget s e
makeScroll :: ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
state = Widget s e
widget where
  widget :: Widget s e
widget = ScrollState -> Container s e ScrollState -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer ScrollState
state Container s e ScrollState
forall a. Default a => a
def {
    containerChildrenOffset :: Maybe Point
containerChildrenOffset = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
offset,
    containerChildrenScissor :: Maybe Rect
containerChildrenScissor = Rect -> Maybe Rect
forall a. a -> Maybe a
Just (ScrollState -> Rect
_sstScissor ScrollState
state),
    containerLayoutDirection :: LayoutDirection
containerLayoutDirection = LayoutDirection
layoutDirection,
    containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = ContainerGetBaseStyle s e
forall s e p. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
    containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle,
    containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init,
    containerMerge :: ContainerMergeHandler s e ScrollState
containerMerge = ContainerMergeHandler s e ScrollState
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> ScrollState -> WidgetResult s e
merge,
    containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = ContainerFindByPointHandler s e
forall a p.
Num a =>
WidgetEnv s e -> WidgetNode s e -> p -> Point -> Maybe a
findByPoint,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = ContainerMessageHandler s e
forall a p.
Typeable a =>
WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize,
    containerRenderAfter :: ContainerRenderHandler s e
containerRenderAfter = ContainerRenderHandler s e
renderAfter
  }

  ScrollState Maybe ActiveBar
dragging Double
dx Double
dy Size
_ Size
_ Rect
_ = ScrollState
state
  Size Double
childWidth Double
childHeight = ScrollState -> Size
_sstChildSize ScrollState
state
  Size Double
maxVpW Double
maxVpH = ScrollState -> Size
_sstVpSize ScrollState
state
  offset :: Point
offset = Double -> Double -> Point
Point Double
dx Double
dy
  scrollType :: ScrollType
scrollType = ScrollType -> Maybe ScrollType -> ScrollType
forall a. a -> Maybe a -> a
fromMaybe ScrollType
ScrollBoth (ScrollCfg s e -> Maybe ScrollType
forall s e. ScrollCfg s e -> Maybe ScrollType
_scScrollType ScrollCfg s e
config)
  layoutDirection :: LayoutDirection
layoutDirection = case ScrollType
scrollType of
    ScrollType
ScrollH -> LayoutDirection
LayoutHorizontal
    ScrollType
ScrollV -> LayoutDirection
LayoutVertical
    ScrollType
ScrollBoth -> LayoutDirection
LayoutNone

  getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
forall s e. ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle ScrollCfg s e
config Maybe (ALens' ThemeState StyleState)
-> (ALens' ThemeState StyleState -> Maybe Style) -> Maybe Style
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ALens' ThemeState StyleState -> Maybe Style
handler where
    handler :: ALens' ThemeState StyleState -> Maybe Style
handler ALens' ThemeState StyleState
lstyle = Style -> Maybe Style
forall a. a -> Maybe a
Just (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (ALens' ThemeState StyleState -> Lens' ThemeState StyleState
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' ThemeState StyleState
lstyle)

  checkFwdStyle :: WidgetEnv s e -> p -> p
checkFwdStyle WidgetEnv s e
wenv p
node = p
newNode where
    fwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle = ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
forall s e.
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle ScrollCfg s e
config
    style :: Style
style = p
node p -> Getting Style p Style -> Style
forall s a. s -> Getting a s a -> a
^. (a -> Const Style a) -> p -> Const Style p
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Style a) -> p -> Const Style p)
-> ((Style -> Const Style Style) -> a -> Const Style a)
-> Getting Style p Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Const Style Style) -> a -> Const Style a
forall s a. HasStyle s a => Lens' s a
L.style
    (Style
parentStyle, Style
childStyle) = Maybe (WidgetEnv s e -> Style -> (Style, Style))
-> WidgetEnv s e -> Style -> (Style, Style)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle WidgetEnv s e
wenv Style
style
    newNode :: p
newNode
      | Maybe (WidgetEnv s e -> Style -> (Style, Style)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle = p
node
        p -> (p -> p) -> p
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> p -> Identity p
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Identity a) -> p -> Identity p)
-> ((Style -> Identity Style) -> a -> Identity a)
-> (Style -> Identity Style)
-> p
-> Identity p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style) -> a -> Identity a
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style) -> p -> Identity p) -> Style -> p -> p
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
parentStyle
        p -> (p -> p) -> p
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> p -> Identity p
forall s a. HasChildren s a => Lens' s a
L.children ((a -> Identity a) -> p -> Identity p)
-> ((Style -> Identity Style) -> a -> Identity a)
-> (Style -> Identity Style)
-> p
-> Identity p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index a -> Traversal' a (IxValue a)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index a
0 ((IxValue a -> Identity (IxValue a)) -> a -> Identity a)
-> ((Style -> Identity Style) -> IxValue a -> Identity (IxValue a))
-> (Style -> Identity Style)
-> a
-> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity a) -> IxValue a -> Identity (IxValue a)
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Identity a) -> IxValue a -> Identity (IxValue a))
-> ((Style -> Identity Style) -> a -> Identity a)
-> (Style -> Identity Style)
-> IxValue a
-> Identity (IxValue a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style) -> a -> Identity a
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style) -> p -> Identity p) -> Style -> p -> p
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
childStyle
      | Bool
otherwise = p
node

  init :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newNode :: WidgetNode s e
newNode = WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall p a a a a.
(HasInfo p a, HasStyle a Style, HasChildren p a, Ixed a,
 Num (Index a), HasInfo p a, HasInfo (IxValue a) a,
 HasStyle a Style, HasStyle a Style) =>
WidgetEnv s e -> p -> p
checkFwdStyle WidgetEnv s e
wenv WidgetNode s e
node

  merge :: WidgetEnv s e
-> WidgetNode s e -> p -> ScrollState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
node p
oldNode ScrollState
oldState = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newNode :: WidgetNode s e
newNode = WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall p a a a a.
(HasInfo p a, HasStyle a Style, HasChildren p a, Ixed a,
 Num (Index a), HasInfo p a, HasInfo (IxValue a) a,
 HasStyle a Style, HasStyle a Style) =>
WidgetEnv s e -> p -> p
checkFwdStyle WidgetEnv s e
wenv (WidgetNode s e -> WidgetNode s e)
-> WidgetNode s e -> WidgetNode s e
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
oldState

  findByPoint :: WidgetEnv s e -> WidgetNode s e -> p -> Point -> Maybe a
findByPoint WidgetEnv s e
wenv WidgetNode s e
node p
start Point
point = Maybe a
result where
    sctx :: ScrollContext
sctx = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
point
    mouseInScroll :: Bool
mouseInScroll
      =  (ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
&& ScrollContext -> Bool
hScrollRequired ScrollContext
sctx)
      Bool -> Bool -> Bool
|| (ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
&& ScrollContext -> Bool
vScrollRequired ScrollContext
sctx)
    childPoint :: Point
childPoint = Point -> Point -> Point
addPoint Point
point Point
offset

    child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) Int
0
    childHovered :: Bool
childHovered = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
child Point
childPoint
    childDragged :: Bool
childDragged = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
child
    result :: Maybe a
result
      | (Bool -> Bool
not Bool
mouseInScroll Bool -> Bool -> Bool
&& Bool
childHovered) Bool -> Bool -> Bool
|| Bool
childDragged = a -> Maybe a
forall a. a -> Maybe a
Just a
0
      | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

  handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    Focus{} -> Maybe (WidgetResult s e)
result where
      overlay :: Maybe (Seq Int)
overlay = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (Maybe (Seq Int)) (WidgetEnv s e) (Maybe (Seq Int))
-> Maybe (Seq Int)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Seq Int)) (WidgetEnv s e) (Maybe (Seq Int))
forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath
      inOverlay :: s -> Bool
inOverlay s
info
        | Maybe (Seq Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Seq Int)
overlay = Seq Int -> Seq Int -> Bool
forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith (Maybe (Seq Int) -> Seq Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Int)
overlay) (s
info s -> Getting (Seq Int) s (Seq Int) -> Seq Int
forall s a. s -> Getting a s a -> a
^. Getting (Seq Int) s (Seq Int)
forall s a. HasPath s a => Lens' s a
L.path)
        | Bool
otherwise = Bool
False
      focusPath :: Seq Int
focusPath = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (Seq Int) (WidgetEnv s e) (Seq Int) -> Seq Int
forall s a. s -> Getting a s a -> a
^. Getting (Seq Int) (WidgetEnv s e) (Seq Int)
forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath
      focusInst :: Maybe WidgetNodeInfo
focusInst = WidgetEnv s e -> WidgetNode s e -> Seq Int -> Maybe WidgetNodeInfo
forall s e.
WidgetEnv s e -> WidgetNode s e -> Seq Int -> Maybe WidgetNodeInfo
findInstOrScroll WidgetEnv s e
wenv WidgetNode s e
node Seq Int
focusPath
      focusVp :: Maybe Rect
focusVp = Maybe WidgetNodeInfo
focusInst Maybe WidgetNodeInfo
-> Getting (First Rect) (Maybe WidgetNodeInfo) Rect -> Maybe Rect
forall s a. s -> Getting (First a) s a -> Maybe a
^? (WidgetNodeInfo -> Const (First Rect) WidgetNodeInfo)
-> Maybe WidgetNodeInfo
-> Const (First Rect) (Maybe WidgetNodeInfo)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((WidgetNodeInfo -> Const (First Rect) WidgetNodeInfo)
 -> Maybe WidgetNodeInfo
 -> Const (First Rect) (Maybe WidgetNodeInfo))
-> ((Rect -> Const (First Rect) Rect)
    -> WidgetNodeInfo -> Const (First Rect) WidgetNodeInfo)
-> Getting (First Rect) (Maybe WidgetNodeInfo) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const (First Rect) Rect)
-> WidgetNodeInfo -> Const (First Rect) WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
      focusOverlay :: Bool
focusOverlay = Bool -> (WidgetNodeInfo -> Bool) -> Maybe WidgetNodeInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False WidgetNodeInfo -> Bool
forall s. HasPath s (Seq Int) => s -> Bool
inOverlay Maybe WidgetNodeInfo
focusInst

      follow :: Bool
follow = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Bool ThemeState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool ThemeState Bool
forall s a. HasScrollFollowFocus s a => Lens' s a
L.scrollFollowFocus) (ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scFollowFocus ScrollCfg s e
config)
      overlayMatch :: Bool
overlayMatch = Bool
focusOverlay Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetNodeInfo -> Bool
forall s. HasPath s (Seq Int) => s -> Bool
inOverlay (WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info)

      result :: Maybe (WidgetResult s e)
result
        | Bool
follow Bool -> Bool -> Bool
&& Bool
overlayMatch = Maybe Rect
focusVp Maybe Rect
-> (Rect -> Maybe (WidgetResult s e)) -> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WidgetEnv s e -> WidgetNode s e -> Rect -> Maybe (WidgetResult s e)
scrollTo WidgetEnv s e
wenv WidgetNode s e
node
        | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    ButtonAction Point
point Button
btn ButtonState
status Int
_ -> Maybe (WidgetResult s e)
result where
      leftPressed :: Bool
leftPressed = ButtonState
status ButtonState -> ButtonState -> Bool
forall a. Eq a => a -> a -> Bool
== ButtonState
BtnPressed Bool -> Bool -> Bool
&& Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
L.mainButton
      btnReleased :: Bool
btnReleased = ButtonState
status ButtonState -> ButtonState -> Bool
forall a. Eq a => a -> a -> Bool
== ButtonState
BtnReleased Bool -> Bool -> Bool
&& Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
L.mainButton

      isDragging :: Bool
isDragging = Maybe ActiveBar -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ActiveBar -> Bool) -> Maybe ActiveBar -> Bool
forall a b. (a -> b) -> a -> b
$ ScrollState -> Maybe ActiveBar
_sstDragging ScrollState
state
      startDrag :: Bool
startDrag = Bool
leftPressed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging

      jumpScrollH :: Bool
jumpScrollH = Bool
btnReleased Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging Bool -> Bool -> Bool
&& ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx
      jumpScrollV :: Bool
jumpScrollV = Bool
btnReleased Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging Bool -> Bool -> Bool
&& ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx

      mouseInScroll :: Bool
mouseInScroll = ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx
      mouseInThumb :: Bool
mouseInThumb = ScrollContext -> Bool
hMouseInThumb ScrollContext
sctx Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInThumb ScrollContext
sctx

      newState :: ScrollState
newState
        | Bool
startDrag Bool -> Bool -> Bool
&& ScrollContext -> Bool
hMouseInThumb ScrollContext
sctx = ScrollState
state { _sstDragging :: Maybe ActiveBar
_sstDragging = ActiveBar -> Maybe ActiveBar
forall a. a -> Maybe a
Just ActiveBar
HBar }
        | Bool
startDrag Bool -> Bool -> Bool
&& ScrollContext -> Bool
vMouseInThumb ScrollContext
sctx = ScrollState
state { _sstDragging :: Maybe ActiveBar
_sstDragging = ActiveBar -> Maybe ActiveBar
forall a. a -> Maybe a
Just ActiveBar
VBar }
        | Bool
jumpScrollH = ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
HBar Point
point Rect
contentArea ScrollContext
sctx
        | Bool
jumpScrollV = ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
VBar Point
point Rect
contentArea ScrollContext
sctx
        | Bool
btnReleased = ScrollState
state { _sstDragging :: Maybe ActiveBar
_sstDragging = Maybe ActiveBar
forall a. Maybe a
Nothing }
        | Bool
otherwise = ScrollState
state

      newRes :: WidgetResult s e
newRes = WidgetEnv s e -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget WidgetEnv s e
wenv WidgetNode s e
node ScrollState
newState
      handledResult :: Maybe (WidgetResult s e)
handledResult = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetResult s e
newRes
        WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollReqs
      result :: Maybe (WidgetResult s e)
result
        | Bool
leftPressed Bool -> Bool -> Bool
&& Bool
mouseInThumb = Maybe (WidgetResult s e)
handledResult
        | Bool
btnReleased Bool -> Bool -> Bool
&& Bool
mouseInScroll = Maybe (WidgetResult s e)
handledResult
        | Bool
btnReleased Bool -> Bool -> Bool
&& Bool
isDragging = Maybe (WidgetResult s e)
handledResult
        | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    Move Point
point | Maybe ActiveBar -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActiveBar
dragging -> Maybe (WidgetResult s e)
result where
      drag :: ActiveBar -> ScrollState
drag ActiveBar
bar = ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
bar Point
point Rect
contentArea ScrollContext
sctx
      makeWidget :: ScrollState -> WidgetResult s e
makeWidget ScrollState
state = WidgetEnv s e -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state
      makeResult :: ScrollState -> WidgetResult s e
makeResult ScrollState
state = ScrollState -> WidgetResult s e
makeWidget ScrollState
state
        WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList (WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce WidgetRequest s e -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. a -> [a] -> [a]
: [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollReqs)
      result :: Maybe (WidgetResult s e)
result = (ActiveBar -> WidgetResult s e)
-> Maybe ActiveBar -> Maybe (WidgetResult s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScrollState -> WidgetResult s e
makeResult (ScrollState -> WidgetResult s e)
-> (ActiveBar -> ScrollState) -> ActiveBar -> WidgetResult s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveBar -> ScrollState
drag) Maybe ActiveBar
dragging

    Move Point
point | Maybe ActiveBar -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ActiveBar
dragging -> Maybe (WidgetResult s e)
result where
      mousePosPrev :: Point
mousePosPrev = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Point InputStatus)
-> WidgetEnv s e -> Const Point (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Const Point InputStatus)
 -> WidgetEnv s e -> Const Point (WidgetEnv s e))
-> ((Point -> Const Point Point)
    -> InputStatus -> Const Point InputStatus)
-> Getting Point (WidgetEnv s e) Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Const Point Point)
-> InputStatus -> Const Point InputStatus
forall s a. HasMousePosPrev s a => Lens' s a
L.mousePosPrev
      psctx :: ScrollContext
psctx = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
mousePosPrev
      changed :: Bool
changed
        = ScrollContext -> Bool
hMouseInThumb ScrollContext
sctx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
hMouseInThumb ScrollContext
psctx
        Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInThumb ScrollContext
sctx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
vMouseInThumb ScrollContext
psctx
        Bool -> Bool -> Bool
|| ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
hMouseInScroll ScrollContext
psctx
        Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
vMouseInScroll ScrollContext
psctx
      result :: Maybe (WidgetResult s e)
result
        | Bool
changed = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
        | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    WheelScroll Point
_ (Point Double
wx Double
wy) WheelDirection
wheelDirection -> Maybe (WidgetResult s e)
result where
      changedX :: Bool
changedX = Double
wx Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0 Bool -> Bool -> Bool
&& Double
childWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cw
      changedY :: Bool
changedY = Double
wy Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0 Bool -> Bool -> Bool
&& Double
childHeight Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
ch

      needsUpdate :: Bool
needsUpdate = Bool
changedX Bool -> Bool -> Bool
|| Bool
changedY
      makeWidget :: ScrollState -> WidgetResult s e
makeWidget ScrollState
state = WidgetEnv s e -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state
      makeResult :: ScrollState -> WidgetResult s e
makeResult ScrollState
state = ScrollState -> WidgetResult s e
makeWidget ScrollState
state
        WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollReqs

      result :: Maybe (WidgetResult s e)
result
        | Bool
needsUpdate = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ ScrollState -> WidgetResult s e
makeResult ScrollState
newState
        | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
      stepX :: Double
stepX
        | WheelDirection
wheelDirection WheelDirection -> WheelDirection -> Bool
forall a. Eq a => a -> a -> Bool
== WheelDirection
WheelNormal = -Double
wheelRate Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wx
        | Bool
otherwise = Double
wheelRate Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wx
      stepY :: Double
stepY
        | WheelDirection
wheelDirection WheelDirection -> WheelDirection -> Bool
forall a. Eq a => a -> a -> Bool
== WheelDirection
WheelNormal = Double
wheelRate Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wy
        | Bool
otherwise = -Double
wheelRate Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wy
      newState :: ScrollState
newState = ScrollState
state {
        _sstDeltaX :: Double
_sstDeltaX = Double -> Double
scrollAxisH (Double
stepX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dx),
        _sstDeltaY :: Double
_sstDeltaY = Double -> Double
scrollAxisV (Double
stepY Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy)
      }

    SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
    where
      theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
      style :: StyleState
style = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
      contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
      mousePos :: Point
mousePos = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Point InputStatus)
-> WidgetEnv s e -> Const Point (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Const Point InputStatus)
 -> WidgetEnv s e -> Const Point (WidgetEnv s e))
-> ((Point -> Const Point Point)
    -> InputStatus -> Const Point InputStatus)
-> Getting Point (WidgetEnv s e) Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Const Point Point)
-> InputStatus -> Const Point InputStatus
forall s a. HasMousePos s a => Lens' s a
L.mousePos

      Rect Double
cx Double
cy Double
cw Double
ch = Rect
contentArea
      sctx :: ScrollContext
sctx = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
mousePos
      scrollReqs :: [WidgetRequest s e]
scrollReqs = [WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreParentEvents]
      wheelCfg :: Rational
wheelCfg = Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Rational ThemeState Rational -> Rational
forall s a. s -> Getting a s a -> a
^. Getting Rational ThemeState Rational
forall s a. HasScrollWheelRate s a => Lens' s a
L.scrollWheelRate) (ScrollCfg s e -> Maybe Rational
forall s e. ScrollCfg s e -> Maybe Rational
_scWheelRate ScrollCfg s e
config)
      wheelRate :: Double
wheelRate = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
wheelCfg

  scrollAxis :: a -> a -> a -> a
scrollAxis a
reqDelta a
childLength a
vpLength
    | a
maxDelta a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a
0
    | a
reqDelta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a -> a -> a
forall a. Ord a => a -> a -> a
max a
reqDelta (-a
maxDelta)
    | Bool
otherwise = a -> a -> a
forall a. Ord a => a -> a -> a
min a
reqDelta a
0
    where
      maxDelta :: a
maxDelta = a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a
childLength a -> a -> a
forall a. Num a => a -> a -> a
- a
vpLength)
  scrollAxisH :: Double -> Double
scrollAxisH Double
delta = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
delta Double
childWidth Double
maxVpW
  scrollAxisV :: Double -> Double
scrollAxisV Double
delta = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
delta Double
childHeight Double
maxVpH

  handleMessage :: WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage WidgetEnv s e
wenv WidgetNode s e
node p
target a
message = Maybe (WidgetResult s e)
result where
    handleScrollMessage :: ScrollMessage -> Maybe (WidgetResult s e)
handleScrollMessage (ScrollTo Rect
rect) = WidgetEnv s e -> WidgetNode s e -> Rect -> Maybe (WidgetResult s e)
scrollTo WidgetEnv s e
wenv WidgetNode s e
node Rect
rect
    handleScrollMessage ScrollMessage
ScrollReset = WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
forall p. p -> WidgetNode s e -> Maybe (WidgetResult s e)
scrollReset WidgetEnv s e
wenv WidgetNode s e
node
    result :: Maybe (WidgetResult s e)
result = a -> Maybe ScrollMessage
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
message Maybe ScrollMessage
-> (ScrollMessage -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScrollMessage -> Maybe (WidgetResult s e)
handleScrollMessage

  scrollTo :: WidgetEnv s e -> WidgetNode s e -> Rect -> Maybe (WidgetResult s e)
scrollTo WidgetEnv s e
wenv WidgetNode s e
node Rect
targetRect = Maybe (WidgetResult s e)
result where
    style :: StyleState
style = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
    contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style

    rect :: Rect
rect = Point -> Rect -> Rect
moveRect Point
offset Rect
targetRect
    Rect Double
rx Double
ry Double
rw Double
rh = Rect
rect
    Rect Double
cx Double
cy Double
_ Double
_ = Rect
contentArea

    diffL :: Double
diffL = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rx
    diffR :: Double
diffR = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
maxVpW Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
rx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rw)
    diffT :: Double
diffT = Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ry
    diffB :: Double
diffB = Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
maxVpH Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rh)

    stepX :: Double
stepX
      | Rect -> Rect -> Bool
rectInRectH Rect
rect Rect
contentArea = Double
dx
      | Double -> Double
forall a. Num a => a -> a
abs Double
diffL Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Double
forall a. Num a => a -> a
abs Double
diffR = Double
diffL Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dx
      | Bool
otherwise = Double
diffR Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dx
    stepY :: Double
stepY
      | Rect -> Rect -> Bool
rectInRectV Rect
rect Rect
contentArea = Double
dy
      | Double -> Double
forall a. Num a => a -> a
abs Double
diffT Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Double
forall a. Num a => a -> a
abs Double
diffB = Double
diffT Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy
      | Bool
otherwise = Double
diffB Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy

    newState :: ScrollState
newState = ScrollState
state {
      _sstDeltaX :: Double
_sstDeltaX = Double -> Double
scrollAxisH Double
stepX,
      _sstDeltaY :: Double
_sstDeltaY = Double -> Double
scrollAxisV Double
stepY
    }
    result :: Maybe (WidgetResult s e)
result
      | Rect -> Rect -> Bool
rectInRect Rect
rect Rect
contentArea = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
      | Bool
otherwise = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget WidgetEnv s e
wenv WidgetNode s e
node ScrollState
newState

  scrollReset :: p -> WidgetNode s e -> Maybe (WidgetResult s e)
scrollReset p
wenv WidgetNode s e
node = Maybe (WidgetResult s e)
result where
    newState :: ScrollState
newState = ScrollState
state {
      _sstDeltaX :: Double
_sstDeltaX = Double
0,
      _sstDeltaY :: Double
_sstDeltaY = Double
0
    }
    result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ p -> WidgetNode s e -> ScrollState -> WidgetResult s e
forall p. p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget p
wenv WidgetNode s e
node ScrollState
newState

  updateScrollThumb :: ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
activeBar Point
point Rect
contentArea ScrollContext
sctx = ScrollState
newState where
    Point Double
px Double
py = Point
point
    ScrollContext{Bool
Double
Rect
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRequired :: Bool
hScrollRequired :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
vThumbRect :: ScrollContext -> Rect
hThumbRect :: ScrollContext -> Rect
vScrollRect :: ScrollContext -> Rect
hScrollRect :: ScrollContext -> Rect
vMouseInThumb :: ScrollContext -> Bool
hMouseInThumb :: ScrollContext -> Bool
vMouseInScroll :: ScrollContext -> Bool
hMouseInScroll :: ScrollContext -> Bool
vScrollRequired :: ScrollContext -> Bool
hScrollRequired :: ScrollContext -> Bool
vScrollRatio :: ScrollContext -> Double
hScrollRatio :: ScrollContext -> Double
..} = ScrollContext
sctx
    Rect Double
cx Double
cy Double
_ Double
_ = Rect
contentArea

    hMid :: Double
hMid = Rect -> Double
_rW Rect
hThumbRect Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    vMid :: Double
vMid = Rect -> Double
_rH Rect
vThumbRect Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2

    hDelta :: Double
hDelta = (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hMid) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
hScrollRatio
    vDelta :: Double
vDelta = (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
vMid) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
vScrollRatio

    newDeltaX :: Double
newDeltaX
      | ActiveBar
activeBar ActiveBar -> ActiveBar -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveBar
HBar = Double -> Double
scrollAxisH Double
hDelta
      | Bool
otherwise = Double
dx
    newDeltaY :: Double
newDeltaY
      | ActiveBar
activeBar ActiveBar -> ActiveBar -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveBar
VBar = Double -> Double
scrollAxisV Double
vDelta
      | Bool
otherwise = Double
dy

    newState :: ScrollState
newState = ScrollState
state {
      _sstDeltaX :: Double
_sstDeltaX = Double
newDeltaX,
      _sstDeltaY :: Double
_sstDeltaY = Double
newDeltaY
    }

  rebuildWidget :: p -> WidgetNode s e -> ScrollState -> WidgetResult s e
rebuildWidget p
wenv WidgetNode s e
node ScrollState
newState = WidgetResult s e
result where
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
newState
    result :: WidgetResult s e
result = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode

  getSizeReq :: ContainerGetSizeReqHandler s e
  getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq, SizeReq)
sizeReq where
    style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
    child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0

    tw :: Double
tw = SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    th :: Double
th = SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH

    Size Double
w Double
h = Size -> Maybe Size -> Size
forall a. a -> Maybe a -> a
fromMaybe Size
forall a. Default a => a
def (StyleState -> Size -> Maybe Size
addOuterSize StyleState
style (Double -> Double -> Size
Size Double
tw Double
th))
    factor :: Double
factor = Double
1

    sizeReq :: (SizeReq, SizeReq)
sizeReq = (Double -> Double -> SizeReq
expandSize Double
w Double
factor, Double -> Double -> SizeReq
expandSize Double
h Double
factor)

  resize :: WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport p
children = (WidgetResult s e, Seq Rect)
result where
    theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
    style :: StyleState
style = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node

    Rect Double
cl Double
ct Double
cw Double
ch = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
    dx :: Double
dx = ScrollState -> Double
_sstDeltaX ScrollState
state
    dy :: Double
dy = ScrollState -> Double
_sstDeltaY ScrollState
state

    child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) Int
0
    childW :: Double
childW = SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    childH :: Double
childH = SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH

    barW :: Double
barW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollBarWidth s a => Lens' s a
L.scrollBarWidth) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
config)
    overlay :: Bool
overlay = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Bool ThemeState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool ThemeState Bool
forall s a. HasScrollOverlay s a => Lens' s a
L.scrollOverlay) (ScrollCfg s e -> Maybe Bool
forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay ScrollCfg s e
config)

    (Double
ncw, Double
nch)
      | Bool -> Bool
not Bool
overlay = (Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW, Double
ch Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW)
      | Bool
otherwise = (Double
cw, Double
ch)
    (Double
maxW, Double
areaW)
      | ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollV Bool -> Bool -> Bool
&& Double
childH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
ch = (Double
ncw, Double
ncw)
      | ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollV = (Double
cw, Double
cw)
      | ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollH = (Double
cw, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
cw Double
childW)
      | Double
childH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
ch Bool -> Bool -> Bool
&& Double
childW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
cw = (Double
cw, Double
cw)
      | Double
childH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
ch = (Double
cw, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
cw Double
childW)
      | Bool
otherwise = (Double
ncw, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
ncw Double
childW)
    (Double
maxH, Double
areaH)
      | ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollH Bool -> Bool -> Bool
&& Double
childW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cw = (Double
nch, Double
nch)
      | ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollH = (Double
ch, Double
ch)
      | ScrollType
scrollType ScrollType -> ScrollType -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollType
ScrollV = (Double
ch, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
ch Double
childH)
      | Double
childW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
cw Bool -> Bool -> Bool
&& Double
childH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
ch = (Double
ch, Double
ch)
      | Double
childW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
cw = (Double
ch, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
ch Double
childH)
      | Bool
otherwise = (Double
nch, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
nch Double
childH)

    newDx :: Double
newDx = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
dx Double
areaW Double
maxW
    newDy :: Double
newDy = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
dy Double
areaH Double
maxH

    scissor :: Rect
scissor = Double -> Double -> Double -> Double -> Rect
Rect Double
cl Double
ct Double
maxW Double
maxH
    cViewport :: Rect
cViewport = Double -> Double -> Double -> Double -> Rect
Rect Double
cl Double
ct Double
areaW Double
areaH

    newState :: ScrollState
newState = ScrollState
state {
      _sstDeltaX :: Double
_sstDeltaX = Double
newDx,
      _sstDeltaY :: Double
_sstDeltaY = Double
newDy,
      _sstVpSize :: Size
_sstVpSize = Double -> Double -> Size
Size Double
maxW Double
maxH,
      _sstChildSize :: Size
_sstChildSize = Double -> Double -> Size
Size Double
areaW Double
areaH,
      _sstScissor :: Rect
_sstScissor = Rect
scissor
    }
    newNode :: WidgetResult s e
newNode = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScrollCfg s e -> ScrollState -> Widget s e
forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
newState
    result :: (WidgetResult s e, Seq Rect)
result = (WidgetResult s e
newNode, Rect -> Seq Rect
forall a. a -> Seq a
Seq.singleton Rect
cViewport)

  renderAfter :: ContainerRenderHandler s e
renderAfter WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hScrollRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
hScrollRect Maybe Color
barColorH Maybe Radius
forall a. Maybe a
Nothing

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
vScrollRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
vScrollRect Maybe Color
barColorV Maybe Radius
forall a. Maybe a
Nothing

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hScrollRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
hThumbRect Maybe Color
thumbColorH Maybe Radius
thumbRadius

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
vScrollRequired (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
vThumbRect Maybe Color
thumbColorV Maybe Radius
thumbRadius
    where
      ScrollContext{Bool
Double
Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
vScrollRequired :: Bool
hScrollRect :: Rect
hScrollRequired :: Bool
vThumbRect :: ScrollContext -> Rect
hThumbRect :: ScrollContext -> Rect
vScrollRect :: ScrollContext -> Rect
hScrollRect :: ScrollContext -> Rect
vMouseInThumb :: ScrollContext -> Bool
hMouseInThumb :: ScrollContext -> Bool
vMouseInScroll :: ScrollContext -> Bool
hMouseInScroll :: ScrollContext -> Bool
vScrollRequired :: ScrollContext -> Bool
hScrollRequired :: ScrollContext -> Bool
vScrollRatio :: ScrollContext -> Double
hScrollRatio :: ScrollContext -> Double
..} = ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
mousePos
      mousePos :: Point
mousePos = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Point InputStatus)
-> WidgetEnv s e -> Const Point (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Const Point InputStatus)
 -> WidgetEnv s e -> Const Point (WidgetEnv s e))
-> ((Point -> Const Point Point)
    -> InputStatus -> Const Point InputStatus)
-> Getting Point (WidgetEnv s e) Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Const Point Point)
-> InputStatus -> Const Point InputStatus
forall s a. HasMousePos s a => Lens' s a
L.mousePos

      draggingH :: Bool
draggingH = ScrollState -> Maybe ActiveBar
_sstDragging ScrollState
state Maybe ActiveBar -> Maybe ActiveBar -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveBar -> Maybe ActiveBar
forall a. a -> Maybe a
Just ActiveBar
HBar
      draggingV :: Bool
draggingV = ScrollState -> Maybe ActiveBar
_sstDragging ScrollState
state Maybe ActiveBar -> Maybe ActiveBar -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveBar -> Maybe ActiveBar
forall a. a -> Maybe a
Just ActiveBar
VBar

      theme :: Theme
theme = WidgetEnv s e
wenv WidgetEnv s e -> Getting Theme (WidgetEnv s e) Theme -> Theme
forall s a. s -> Getting a s a -> a
^. Getting Theme (WidgetEnv s e) Theme
forall s a. HasTheme s a => Lens' s a
L.theme
      athm :: ThemeState
athm = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
      tmpRad :: Double
tmpRad = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
athm ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollThumbRadius s a => Lens' s a
L.scrollThumbRadius) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbRadius ScrollCfg s e
config)
      thumbRadius :: Maybe Radius
thumbRadius
        | Double
tmpRad Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Radius -> Maybe Radius
forall a. a -> Maybe a
Just (Double -> Radius
forall t. CmbRadius t => Double -> t
radius Double
tmpRad)
        | Bool
otherwise = Maybe Radius
forall a. Maybe a
Nothing

      cfgBarBCol :: Maybe Color
cfgBarBCol = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarColor ScrollCfg s e
config
      cfgBarHCol :: Maybe Color
cfgBarHCol = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scBarHoverColor ScrollCfg s e
config
      cfgThumbBCol :: Maybe Color
cfgThumbBCol = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbColor ScrollCfg s e
config
      cfgThumbHCol :: Maybe Color
cfgThumbHCol = ScrollCfg s e -> Maybe Color
forall s e. ScrollCfg s e -> Maybe Color
_scThumbHoverColor ScrollCfg s e
config

      barBCol :: Maybe Color
barBCol = Maybe Color
cfgBarBCol Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Color -> Maybe Color
forall a. a -> Maybe a
Just (Theme
theme Theme -> Getting Color Theme Color -> Color
forall s a. s -> Getting a s a -> a
^. (ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme
forall s a. HasBasic s a => Lens' s a
L.basic ((ThemeState -> Const Color ThemeState)
 -> Theme -> Const Color Theme)
-> ((Color -> Const Color Color)
    -> ThemeState -> Const Color ThemeState)
-> Getting Color Theme Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState
forall s a. HasScrollBarColor s a => Lens' s a
L.scrollBarColor)
      barHCol :: Maybe Color
barHCol = Maybe Color
cfgBarHCol Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Color -> Maybe Color
forall a. a -> Maybe a
Just (Theme
theme Theme -> Getting Color Theme Color -> Color
forall s a. s -> Getting a s a -> a
^. (ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme
forall s a. HasHover s a => Lens' s a
L.hover ((ThemeState -> Const Color ThemeState)
 -> Theme -> Const Color Theme)
-> ((Color -> Const Color Color)
    -> ThemeState -> Const Color ThemeState)
-> Getting Color Theme Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState
forall s a. HasScrollBarColor s a => Lens' s a
L.scrollBarColor)

      thumbBCol :: Maybe Color
thumbBCol = Maybe Color
cfgThumbBCol Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Color -> Maybe Color
forall a. a -> Maybe a
Just (Theme
theme Theme -> Getting Color Theme Color -> Color
forall s a. s -> Getting a s a -> a
^. (ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme
forall s a. HasBasic s a => Lens' s a
L.basic ((ThemeState -> Const Color ThemeState)
 -> Theme -> Const Color Theme)
-> ((Color -> Const Color Color)
    -> ThemeState -> Const Color ThemeState)
-> Getting Color Theme Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState
forall s a. HasScrollThumbColor s a => Lens' s a
L.scrollThumbColor)
      thumbHCol :: Maybe Color
thumbHCol = Maybe Color
cfgThumbHCol Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Color -> Maybe Color
forall a. a -> Maybe a
Just (Theme
theme Theme -> Getting Color Theme Color -> Color
forall s a. s -> Getting a s a -> a
^. (ThemeState -> Const Color ThemeState)
-> Theme -> Const Color Theme
forall s a. HasHover s a => Lens' s a
L.hover((ThemeState -> Const Color ThemeState)
 -> Theme -> Const Color Theme)
-> ((Color -> Const Color Color)
    -> ThemeState -> Const Color ThemeState)
-> Getting Color Theme Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Const Color Color)
-> ThemeState -> Const Color ThemeState
forall s a. HasScrollThumbColor s a => Lens' s a
L.scrollThumbColor)

      barColorH :: Maybe Color
barColorH
        | Bool
hMouseInScroll = Maybe Color
barHCol
        | Bool
otherwise = Maybe Color
barBCol
      barColorV :: Maybe Color
barColorV
        | Bool
vMouseInScroll = Maybe Color
barHCol
        | Bool
otherwise = Maybe Color
barBCol
      thumbColorH :: Maybe Color
thumbColorH
        | Bool
hMouseInThumb Bool -> Bool -> Bool
|| Bool
draggingH = Maybe Color
thumbHCol
        | Bool
otherwise = Maybe Color
thumbBCol
      thumbColorV :: Maybe Color
thumbColorV
        | Bool
vMouseInThumb Bool -> Bool -> Bool
|| Bool
draggingV = Maybe Color
thumbHCol
        | Bool
otherwise = Maybe Color
thumbBCol

scrollCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
  | WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
child = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle WidgetEnv s e
wenv WidgetNode s e
node
  | Bool
otherwise = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  where
    child :: WidgetNode s e
child = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children Seq (WidgetNode s e)
-> Getting
     (Endo (WidgetNode s e)) (Seq (WidgetNode s e)) (WidgetNode s e)
-> WidgetNode s e
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Seq (WidgetNode s e))
-> Traversal'
     (Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Seq (WidgetNode s e))
0

scrollStatus
  :: ScrollCfg s e
  -> WidgetEnv s e
  -> WidgetNode s e
  -> ScrollState
  -> Point
  -> ScrollContext
scrollStatus :: ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
scrollState Point
mousePos = ScrollContext :: Double
-> Double
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Rect
-> Rect
-> Rect
-> Rect
-> ScrollContext
ScrollContext{Bool
Double
Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vScrollRequired :: Bool
hScrollRequired :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRequired :: Bool
hScrollRequired :: Bool
vScrollRatio :: Double
hScrollRatio :: Double
..} where
  ScrollState Maybe ActiveBar
_ Double
dx Double
dy Size
_ Size
_ Rect
_ = ScrollState
scrollState
  Size Double
childWidth Double
childHeight = ScrollState -> Size
_sstChildSize ScrollState
scrollState
  Size Double
vpWidth Double
vpHeight = ScrollState -> Size
_sstVpSize ScrollState
scrollState
  theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
  style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
  contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style

  barW :: Double
barW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollBarWidth s a => Lens' s a
L.scrollBarWidth) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
config)
  thumbW :: Double
thumbW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasScrollThumbWidth s a => Lens' s a
L.scrollThumbWidth) (ScrollCfg s e -> Maybe Double
forall s e. ScrollCfg s e -> Maybe Double
_scThumbWidth ScrollCfg s e
config)

  caLeft :: Double
caLeft = Rect -> Double
_rX Rect
contentArea
  caTop :: Double
caTop = Rect -> Double
_rY Rect
contentArea
  caWidth :: Double
caWidth = Rect -> Double
_rW Rect
contentArea
  caHeight :: Double
caHeight = Rect -> Double
_rH Rect
contentArea

  hScrollTop :: Double
hScrollTop = Double
caHeight Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW
  vScrollLeft :: Double
vScrollLeft = Double
caWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW

  hRatio :: Double
hRatio = Double
caWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
childWidth
  vRatio :: Double
vRatio = Double
caHeight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
childHeight
  hRatioR :: Double
hRatioR = (Double
caWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
childWidth
  vRatioR :: Double
vRatioR = (Double
caHeight Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
childHeight

  (Double
hScrollRatio, Double
vScrollRatio)
    | Double
hRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
&& Double
vRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 = (Double
hRatioR, Double
vRatioR)
    | Bool
otherwise = (Double
hRatio, Double
vRatio)
  hScrollRequired :: Bool
hScrollRequired = Double
hScrollRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1
  vScrollRequired :: Bool
vScrollRequired = Double
vScrollRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1

  hScrollRect :: Rect
hScrollRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
    _rX :: Double
_rX = Double
caLeft,
    _rY :: Double
_rY = Double
caTop Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hScrollTop,
    _rW :: Double
_rW = Double
vpWidth,
    _rH :: Double
_rH = Double
barW
  }
  vScrollRect :: Rect
vScrollRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
    _rX :: Double
_rX = Double
caLeft Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
vScrollLeft,
    _rY :: Double
_rY = Double
caTop,
    _rW :: Double
_rW = Double
barW,
    _rH :: Double
_rH = Double
vpHeight
  }
  hThumbRect :: Rect
hThumbRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
    _rX :: Double
_rX = Double
caLeft Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hScrollRatio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dx,
    _rY :: Double
_rY = Double
caTop Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hScrollTop Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
barW Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
thumbW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2,
    _rW :: Double
_rW = Double
hScrollRatio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
vpWidth,
    _rH :: Double
_rH = Double
thumbW
  }
  vThumbRect :: Rect
vThumbRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
    _rX :: Double
_rX = Double
caLeft Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
vScrollLeft Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
barW Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
thumbW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2,
    _rY :: Double
_rY = Double
caTop Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vScrollRatio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dy,
    _rW :: Double
_rW = Double
thumbW,
    _rH :: Double
_rH = Double
vScrollRatio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
vpHeight
  }

  hMouseInScroll :: Bool
hMouseInScroll = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
hScrollRect
  vMouseInScroll :: Bool
vMouseInScroll = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
vScrollRect

  hMouseInThumb :: Bool
hMouseInThumb = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
hThumbRect
  vMouseInThumb :: Bool
vMouseInThumb = Point -> Rect -> Bool
pointInRect Point
mousePos Rect
vThumbRect

findInstOrScroll
  :: WidgetEnv s e -> WidgetNode s e -> Seq.Seq PathStep -> Maybe WidgetNodeInfo
findInstOrScroll :: WidgetEnv s e -> WidgetNode s e -> Seq Int -> Maybe WidgetNodeInfo
findInstOrScroll WidgetEnv s e
wenv WidgetNode s e
node Seq Int
target = Maybe WidgetNodeInfo
wniScroll Maybe WidgetNodeInfo
-> Maybe WidgetNodeInfo -> Maybe WidgetNodeInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe WidgetNodeInfo
wniTarget where
  child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) Int
0
  isScroll :: s -> Bool
isScroll s
wni = s
wni s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasWidgetType s a => Lens' s a
L.widgetType a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"scroll"
  branch :: Seq WidgetNodeInfo
branch = Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Seq Int -> Seq WidgetNodeInfo
forall s e.
Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Seq Int -> Seq WidgetNodeInfo
widgetFindBranchByPath (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
child Seq Int
target
  scrolls :: Seq WidgetNodeInfo
scrolls = (WidgetNodeInfo -> Bool)
-> Seq WidgetNodeInfo -> Seq WidgetNodeInfo
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter WidgetNodeInfo -> Bool
forall a s. (Eq a, HasWidgetType s a, IsString a) => s -> Bool
isScroll Seq WidgetNodeInfo
branch
  wniTarget :: Maybe WidgetNodeInfo
wniTarget = Int -> Seq WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq WidgetNodeInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
branch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
branch
  wniScroll :: Maybe WidgetNodeInfo
wniScroll = Int -> Seq WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq WidgetNodeInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq WidgetNodeInfo
scrolls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq WidgetNodeInfo
scrolls