{-|
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.

Accepts the following messages:

- 'ScrollTo': Causes the scroll to update its handles to ensure rect is visible.
- 'ScrollReset': Sets both handle positions to zero.

@
vscroll (vstack longItemsList)
@
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Containers.Scroll (
  -- * Configuration
  ScrollCfg,
  ScrollStatus(..),
  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
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
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)

{-|
Information provided in the 'onChange' event.

The currently visible viewport is affected by the position of the scroll bars,
their size and any other parent widget that restricts the visible viewport
(e.g., another scroll).
-}
data ScrollStatus = ScrollStatus {
  ScrollStatus -> Double
scrollDeltaX :: Double, -- ^ Displacement in the x axis.
  ScrollStatus -> Double
scrollDeltaY :: Double, -- ^ Displacement in the y axis.
  ScrollStatus -> Rect
scrollRect :: Rect,     -- ^ The viewport assigned to the scroll widget.
  ScrollStatus -> Size
scrollVpSize :: Size,   -- ^ The currently visible viewport.
  ScrollStatus -> Size
scrollChildSize :: Size -- ^ The total size of the child widget.
} deriving (ScrollStatus -> ScrollStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollStatus -> ScrollStatus -> Bool
$c/= :: ScrollStatus -> ScrollStatus -> Bool
== :: ScrollStatus -> ScrollStatus -> Bool
$c== :: ScrollStatus -> ScrollStatus -> Bool
Eq, Int -> ScrollStatus -> ShowS
[ScrollStatus] -> ShowS
ScrollStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollStatus] -> ShowS
$cshowList :: [ScrollStatus] -> ShowS
show :: ScrollStatus -> String
$cshow :: ScrollStatus -> String
showsPrec :: Int -> ScrollStatus -> ShowS
$cshowsPrec :: Int -> ScrollStatus -> ShowS
Show)

instance Default ScrollStatus where
  def :: ScrollStatus
def = ScrollStatus {
    scrollDeltaX :: Double
scrollDeltaX = Double
0,
    scrollDeltaY :: Double
scrollDeltaY = Double
0,
    scrollRect :: Rect
scrollRect = forall a. Default a => a
def,
    scrollVpSize :: Size
scrollVpSize = forall a. Default a => a
def,
    scrollChildSize :: Size
scrollChildSize = forall a. Default a => a
def
  }

data ActiveBar
  = HBar
  | VBar
  deriving (ActiveBar -> ActiveBar -> Bool
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
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. 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:

- '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.
- '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.
- 'thumbMinSize': the minimum size of the thumb.
- 'thumbRadius': the radius of the corners of the thumb.
- 'onChange': event to raise when the viewport changes.
- 'onChangeReq': 'WidgetRequest' to generate when the viewport changes.
-}
data ScrollCfg s e = ScrollCfg {
  forall s e. ScrollCfg s e -> Maybe ScrollType
_scScrollType :: Maybe ScrollType,
  forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay :: Maybe Bool,
  forall s e.
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style)),
  forall s e. ScrollCfg s e -> Maybe Bool
_scFollowFocus :: Maybe Bool,
  forall s e. ScrollCfg s e -> Maybe Rational
_scWheelRate :: Maybe Rational,
  forall s e. ScrollCfg s e -> Maybe Color
_scBarColor :: Maybe Color,
  forall s e. ScrollCfg s e -> Maybe Color
_scBarHoverColor :: Maybe Color,
  forall s e. ScrollCfg s e -> Maybe Color
_scThumbColor :: Maybe Color,
  forall s e. ScrollCfg s e -> Maybe Color
_scThumbHoverColor :: Maybe Color,
  forall s e. ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle :: Maybe (ALens' ThemeState StyleState),
  forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth :: Maybe Double,
  forall s e. ScrollCfg s e -> Maybe Double
_scThumbWidth :: Maybe Double,
  forall s e. ScrollCfg s e -> Maybe Double
_scThumbMinSize :: Maybe Double,
  forall s e. ScrollCfg s e -> Maybe Double
_scThumbRadius :: Maybe Double,
  forall s e. ScrollCfg s e -> [ScrollStatus -> WidgetRequest s e]
_scOnChangeReq :: [ScrollStatus -> WidgetRequest s e]
}

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

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

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

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

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

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

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

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

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

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

instance CmbThumbMinSize (ScrollCfg s e) where
  thumbMinSize :: Double -> ScrollCfg s e
thumbMinSize Double
w = forall a. Default a => a
def {
    _scThumbMinSize :: Maybe Double
_scThumbMinSize = forall a. a -> Maybe a
Just Double
w
  }

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

instance WidgetEvent e => CmbOnChange (ScrollCfg s e) ScrollStatus e where
  onChange :: (ScrollStatus -> e) -> ScrollCfg s e
onChange ScrollStatus -> e
fn = forall a. Default a => a
def {
    _scOnChangeReq :: [ScrollStatus -> WidgetRequest s e]
_scOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrollStatus -> e
fn]
  }

instance CmbOnChangeReq (ScrollCfg s e) s e ScrollStatus where
  onChangeReq :: (ScrollStatus -> WidgetRequest s e) -> ScrollCfg s e
onChangeReq ScrollStatus -> WidgetRequest s e
req = forall a. Default a => a
def {
    _scOnChangeReq :: [ScrollStatus -> WidgetRequest s e]
_scOnChangeReq = [ScrollStatus -> WidgetRequest s e
req]
  }

-- | Scroll bars will be displayed on top of the content.
scrollOverlay :: ScrollCfg s e
scrollOverlay :: forall s e. ScrollCfg s e
scrollOverlay = 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_ :: forall s e. Bool -> ScrollCfg s e
scrollOverlay_ Bool
overlay = forall a. Default a => a
def {
  _scScrollOverlay :: Maybe Bool
_scScrollOverlay = 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 :: forall s e.
(WidgetEnv s e -> Style -> (Style, Style)) -> ScrollCfg s e
scrollFwdStyle WidgetEnv s e -> Style -> (Style, Style)
fwd = forall a. Default a => a
def {
  _scScrollFwdStyle :: Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle = 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 :: forall s e. WidgetEnv s e -> Style -> (Style, Style)
scrollFwdDefault WidgetEnv s e
wenv Style
style = (Style
scrollStyle, Style
childStyle) where
  scrollStyle :: Style
scrollStyle = forall a. Default a => a
def
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasBorder s a => Lens' s a
L.border Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasRadius s a => Lens' s a
L.radius Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasBgColor s a => Lens' s a
L.bgColor Style
style
  childStyle :: Style
childStyle = forall a. Default a => a
def
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasPadding s a => Lens' s a
L.padding Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasFgColor s a => Lens' s a
L.fgColor Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasSndColor s a => Lens' s a
L.sndColor Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasHlColor s a => Lens' s a
L.hlColor Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasText s a => Lens' s a
L.text Style
style
    forall a b. a -> (a -> b) -> b
& forall t. Lens' StyleState (Maybe t) -> Style -> Style -> Style
collectStyleField_ forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon Style
style

-- | Sets the style of the scroll bars to transparent.
scrollInvisible :: ScrollCfg s e
scrollInvisible :: forall s e. ScrollCfg s e
scrollInvisible = 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_ :: forall s e. Bool -> ScrollCfg s e
scrollInvisible_ Bool
False = forall a. Default a => a
def
scrollInvisible_ Bool
True = forall a. Default a => a
def {
  _scScrollOverlay :: Maybe Bool
_scScrollOverlay = forall a. a -> Maybe a
Just Bool
True,
  _scBarColor :: Maybe Color
_scBarColor = forall a. a -> Maybe a
Just Color
transparent,
  _scBarHoverColor :: Maybe Color
_scBarHoverColor = forall a. a -> Maybe a
Just Color
transparent,
  _scThumbColor :: Maybe Color
_scThumbColor = forall a. a -> Maybe a
Just Color
transparent,
  _scThumbHoverColor :: Maybe Color
_scThumbHoverColor = forall a. a -> Maybe a
Just Color
transparent
}

-- | Makes the scroll automatically follow focused items to make them visible.
scrollFollowFocus :: ScrollCfg s e
scrollFollowFocus :: forall s e. ScrollCfg s e
scrollFollowFocus = 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_ :: forall s e. Bool -> ScrollCfg s e
scrollFollowFocus_ Bool
follow = forall a. Default a => a
def {
  _scFollowFocus :: Maybe Bool
_scFollowFocus = 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 :: forall s e. ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle ALens' ThemeState StyleState
style = forall a. Default a => a
def {
  _scStyle :: Maybe (ALens' ThemeState StyleState)
_scStyle = forall a. a -> Maybe a
Just ALens' ThemeState StyleState
style
}

-- Not exported
scrollType :: ScrollType -> ScrollCfg s e
scrollType :: forall s e. ScrollType -> ScrollCfg s e
scrollType ScrollType
st = forall a. Default a => a
def {
  _scScrollType :: Maybe ScrollType
_scScrollType = 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 -> Double
_sstThumbOffsetX :: !Double,
  ScrollState -> Double
_sstThumbOffsetY :: !Double,
  ScrollState -> Size
_sstVpSize :: Size,
  ScrollState -> Size
_sstChildSize :: Size,
  ScrollState -> Rect
_sstScissor :: Rect
} deriving (ScrollState -> ScrollState -> Bool
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
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. 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
hThumbRatio :: Double,
  ScrollContext -> Double
vThumbRatio :: 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
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
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 {
    _sstDragging :: Maybe ActiveBar
_sstDragging = forall a. Maybe a
Nothing,
    _sstDeltaX :: Double
_sstDeltaX = Double
0,
    _sstDeltaY :: Double
_sstDeltaY = Double
0,
    _sstThumbOffsetX :: Double
_sstThumbOffsetX = Double
0,
    _sstThumbOffsetY :: Double
_sstThumbOffsetY = Double
0,
    _sstVpSize :: Size
_sstVpSize = forall a. Default a => a
def,
    _sstChildSize :: Size
_sstChildSize = forall a. Default a => a
def,
    _sstScissor :: Rect
_sstScissor = 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
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
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 :: forall s e. WidgetNode s e -> WidgetNode s e
scroll WidgetNode s e
managedWidget = forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ 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_ :: forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [ScrollCfg s e]
configs WidgetNode s e
managed = forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config forall a. Default a => a
def) WidgetNode s e
managed where
  config :: ScrollCfg s e
config = 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 :: forall s e. WidgetNode s e -> WidgetNode s e
hscroll WidgetNode s e
managedWidget = forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
hscroll_ 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_ :: forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
hscroll_ [ScrollCfg s e]
configs WidgetNode s e
managed = forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config forall a. Default a => a
def) WidgetNode s e
managed where
  config :: ScrollCfg s e
config = forall a. Monoid a => [a] -> a
mconcat (forall s e. ScrollType -> ScrollCfg s e
scrollType ScrollType
ScrollH 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 :: forall s e. WidgetNode s e -> WidgetNode s e
vscroll WidgetNode s e
managedWidget = forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
vscroll_ 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_ :: forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
vscroll_ [ScrollCfg s e]
configs WidgetNode s e
managed = forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config forall a. Default a => a
def) WidgetNode s e
managed where
  config :: ScrollCfg s e
config = forall a. Monoid a => [a] -> a
mconcat (forall s e. ScrollType -> ScrollCfg s e
scrollType ScrollType
ScrollV forall a. a -> [a] -> [a]
: [ScrollCfg s e]
configs)

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

makeScroll :: ScrollCfg s e -> ScrollState -> Widget s e
makeScroll :: forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
state = Widget s e
widget where
  container :: Container s e ScrollState
container = forall a. Default a => a
def {
    containerChildrenOffset :: Maybe Point
containerChildrenOffset = forall a. a -> Maybe a
Just Point
offset,
    containerChildrenScissor :: Maybe Rect
containerChildrenScissor = forall a. a -> Maybe a
Just (ScrollState -> Rect
_sstScissor ScrollState
state),
    containerLayoutDirection :: LayoutDirection
containerLayoutDirection = LayoutDirection
layoutDirection,
    containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = forall {s} {e} {p}. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
    containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle,
    containerCreateContainerFromModel :: ContainerCreateContainerFromModel s e ScrollState
containerCreateContainerFromModel = ContainerCreateContainerFromModel s e ScrollState
createContainerFromModel,
    containerUpdateCWenv :: ContainerUpdateCWenvHandler s e
containerUpdateCWenv = forall {p} {p}.
WidgetEnv s e -> WidgetNode s e -> p -> p -> WidgetEnv s e
updateCWenv,
    containerInit :: ContainerInitHandler s e
containerInit = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init,
    containerMerge :: ContainerMergeHandler s e ScrollState
containerMerge = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> ScrollState -> WidgetResult s e
merge,
    containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = forall {a} {p}.
Num a =>
WidgetEnv s e -> WidgetNode s e -> p -> Point -> Maybe a
findByPoint,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
handleEvent,
    containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = forall {p} {p}.
Typeable p =>
WidgetEnv s e
-> WidgetNode s e -> p -> p -> Maybe (WidgetResult s e)
handleMessage,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = 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
  }
  widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer ScrollState
state Container s e ScrollState
container

  (Maybe ActiveBar
dragging, Double
dx, Double
dy) = (ScrollState -> Maybe ActiveBar
_sstDragging ScrollState
state, ScrollState -> Double
_sstDeltaX ScrollState
state, ScrollState -> Double
_sstDeltaY 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 = forall a. a -> Maybe a -> a
fromMaybe ScrollType
ScrollBoth (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 = forall s e. ScrollCfg s e -> Maybe (ALens' ThemeState StyleState)
_scStyle ScrollCfg s e
config 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (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 = forall s e.
ScrollCfg s e -> Maybe (WidgetEnv s e -> Style -> (Style, Style))
_scScrollFwdStyle ScrollCfg s e
config
    style :: Style
style = p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style
    (Style
parentStyle, Style
childStyle)
      | forall a. Maybe a -> Bool
isJust Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle WidgetEnv s e
wenv Style
style
      | Bool
otherwise = forall a. Default a => a
def
    newNode :: p
newNode
      | forall a. Maybe a -> Bool
isJust Maybe (WidgetEnv s e -> Style -> (Style, Style))
fwdStyle = p
node
        forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
parentStyle
        forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index a
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
childStyle
      | Bool
otherwise = p
node

  createContainerFromModel :: ContainerCreateContainerFromModel s e ScrollState
createContainerFromModel WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state = forall a. a -> Maybe a
Just Container s e ScrollState
newContainer where
    offset :: Point
offset = Double -> Double -> Point
Point (ScrollState -> Double
_sstDeltaX ScrollState
state) (ScrollState -> Double
_sstDeltaX ScrollState
state)
    newContainer :: Container s e ScrollState
newContainer = Container s e ScrollState
container {
      containerChildrenOffset :: Maybe Point
containerChildrenOffset = forall a. a -> Maybe a
Just Point
offset
    }

  -- This is overriden to account for space used by scroll bars
  updateCWenv :: WidgetEnv s e -> WidgetNode s e -> p -> p -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node p
cnode p
cidx = WidgetEnv s e
newWenv where
    theme :: ThemeState
theme = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
    barW :: Double
barW = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasScrollBarWidth s a => Lens' s a
L.scrollBarWidth) (forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
config)
    overlay :: Bool
overlay = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasScrollOverlay s a => Lens' s a
L.scrollOverlay) (forall s e. ScrollCfg s e -> Maybe Bool
_scScrollOverlay ScrollCfg s e
config)

    ScrollContext{Bool
Double
Rect
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRequired :: Bool
hScrollRequired :: Bool
vThumbRatio :: Double
hThumbRatio :: 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
vThumbRatio :: ScrollContext -> Double
hThumbRatio :: ScrollContext -> Double
..} = forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state (Double -> Double -> Point
Point Double
0 Double
0)
    style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    carea :: Rect
carea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style

    -- barH consumes vertical space, barV consumes horizontal space
    barH :: Double
barH
      | Bool
hScrollRequired Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
overlay = Double
barW
      | Bool
otherwise = Double
0
    barV :: Double
barV
      | Bool
vScrollRequired Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
overlay = Double
barW
      | Bool
otherwise = Double
0
    clientArea :: Maybe Rect
clientArea = Rect -> Double -> Double -> Double -> Double -> Maybe Rect
subtractFromRect Rect
carea Double
0 Double
barV Double
0 Double
barH

    newWenv :: WidgetEnv s e
newWenv = WidgetEnv s e
wenv
      forall a b. a -> (a -> b) -> b
& forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point -> Rect -> Rect
moveRect (Point -> Point
negPoint Point
offset) (forall a. a -> Maybe a -> a
fromMaybe Rect
carea Maybe Rect
clientArea)

  init :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newNode :: WidgetNode s e
newNode = 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 = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newNode :: WidgetNode s e
newNode = 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 forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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
    -- The point argument already has offset applied
    scrollPoint :: Point
scrollPoint = Point -> Point -> Point
subPoint Point
point Point
offset
    sctx :: ScrollContext
sctx = forall s e.
ScrollCfg s e
-> WidgetEnv s e
-> WidgetNode s e
-> ScrollState
-> Point
-> ScrollContext
scrollStatus ScrollCfg s e
config WidgetEnv s e
wenv WidgetNode s e
node ScrollState
state Point
scrollPoint
    mouseInScroll :: Bool
mouseInScroll
      =  (ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
&& ScrollContext -> Bool
hScrollRequired ScrollContext
sctx)
      Bool -> Bool -> Bool
|| (ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx Bool -> Bool -> Bool
&& ScrollContext -> Bool
vScrollRequired ScrollContext
sctx)

    child :: WidgetNode s e
child = forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
0
    childHovered :: Bool
childHovered = forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
child Point
point
    childDragged :: Bool
childDragged = 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 = forall a. a -> Maybe a
Just a
0
      | Bool
otherwise = forall a. Maybe a
Nothing

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

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

      fwdFocus :: Maybe (WidgetResult s e)
fwdFocus = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus forall a. Maybe a
Nothing FocusDirection
FocusFwd])

      result :: Maybe (WidgetResult s e)
result
        | Path
target forall a. Eq a => a -> a -> Bool
== WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path = Maybe (WidgetResult s e)
fwdFocus
        | Bool
follow Bool -> Bool -> Bool
&& Bool
overlayMatch = Maybe Rect
focusVp 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 = forall a. Maybe a
Nothing

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

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

      startDragH :: Bool
startDragH = Bool
mainPressed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging Bool -> Bool -> Bool
&& ScrollContext -> Bool
hMouseInThumb ScrollContext
sctx
      startDragV :: Bool
startDragV = Bool
mainPressed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDragging Bool -> Bool -> Bool
&& ScrollContext -> Bool
vMouseInThumb ScrollContext
sctx

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

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

      thumbOffsetX :: Double
thumbOffsetX = Point
point forall s a. s -> Getting a s a -> a
^. forall s a. HasX s a => Lens' s a
L.x forall a. Num a => a -> a -> a
- ScrollContext -> Rect
hThumbRect ScrollContext
sctx forall s a. s -> Getting a s a -> a
^. forall s a. HasX s a => Lens' s a
L.x
      thumbOffsetY :: Double
thumbOffsetY = Point
point forall s a. s -> Getting a s a -> a
^. forall s a. HasY s a => Lens' s a
L.y forall a. Num a => a -> a -> a
- ScrollContext -> Rect
vThumbRect ScrollContext
sctx forall s a. s -> Getting a s a -> a
^. forall s a. HasY s a => Lens' s a
L.y

      newState :: ScrollState
newState
        | Bool
startDragH = ScrollState
state {
            _sstDragging :: Maybe ActiveBar
_sstDragging = forall a. a -> Maybe a
Just ActiveBar
HBar,
            _sstThumbOffsetX :: Double
_sstThumbOffsetX = Double
thumbOffsetX,
            _sstThumbOffsetY :: Double
_sstThumbOffsetY = Double
0
          }
        | Bool
startDragV = ScrollState
state {
            _sstDragging :: Maybe ActiveBar
_sstDragging = forall a. a -> Maybe a
Just ActiveBar
VBar,
            _sstThumbOffsetX :: Double
_sstThumbOffsetX = Double
0,
            _sstThumbOffsetY :: Double
_sstThumbOffsetY = Double
thumbOffsetY
          }
        | Bool
jumpScrollH = ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
HBar Point
point Rect
contentArea ScrollContext
sctx
        | Bool
jumpScrollV = ScrollState
-> ActiveBar -> Point -> Rect -> ScrollContext -> ScrollState
updateScrollThumb ScrollState
state ActiveBar
VBar Point
point Rect
contentArea ScrollContext
sctx
        | Bool
mainReleased = ScrollState
state { _sstDragging :: Maybe ActiveBar
_sstDragging = forall a. Maybe a
Nothing }
        | Bool
otherwise = ScrollState
state

      newRes :: WidgetResult s e
newRes = 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
newRes
        forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList forall {s} {e}. [WidgetRequest s e]
scrollReqs
      result :: Maybe (WidgetResult s e)
result
        | Bool
mainPressed Bool -> Bool -> Bool
&& (Bool
mouseInThumb Bool -> Bool -> Bool
|| Bool
mouseInScroll) = Maybe (WidgetResult s e)
handledResult
        | Bool
mainReleased Bool -> Bool -> Bool
&& Bool
isDragging = Maybe (WidgetResult s e)
handledResult
        | Bool
otherwise = forall a. Maybe a
Nothing

    Move Point
point | 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 = 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
        forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList (forall s e. WidgetRequest s e
RenderOnce forall a. a -> [a] -> [a]
: forall {s} {e}. [WidgetRequest s e]
scrollReqs)
      result :: Maybe (WidgetResult s e)
result = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScrollState -> WidgetResult s e
makeResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveBar -> ScrollState
drag) Maybe ActiveBar
dragging

    Move Point
point | forall a. Maybe a -> Bool
isNothing Maybe ActiveBar
dragging -> Maybe (WidgetResult s e)
result where
      mousePosPrev :: Point
mousePosPrev = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePosPrev s a => Lens' s a
L.mousePosPrev
      psctx :: ScrollContext
psctx = 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 forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
hMouseInThumb ScrollContext
psctx
        Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInThumb ScrollContext
sctx forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
vMouseInThumb ScrollContext
psctx
        Bool -> Bool -> Bool
|| ScrollContext -> Bool
hMouseInScroll ScrollContext
sctx forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
hMouseInScroll ScrollContext
psctx
        Bool -> Bool -> Bool
|| ScrollContext -> Bool
vMouseInScroll ScrollContext
sctx forall a. Eq a => a -> a -> Bool
/= ScrollContext -> Bool
vMouseInScroll ScrollContext
psctx
      result :: Maybe (WidgetResult s e)
result
        | Bool
changed = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
RenderOnce]
        | Bool
otherwise = 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 forall a. Eq a => a -> a -> Bool
/= Double
0 Bool -> Bool -> Bool
&& Double
childWidth forall a. Ord a => a -> a -> Bool
> Double
cw
      changedY :: Bool
changedY = Double
wy forall a. Eq a => a -> a -> Bool
/= Double
0 Bool -> Bool -> Bool
&& Double
childHeight 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 = 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
        forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList forall {s} {e}. [WidgetRequest s e]
scrollReqs

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

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

      Rect Double
cx Double
cy Double
cw Double
ch = Rect
contentArea
      sctx :: ScrollContext
sctx = 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 = [forall s e. WidgetRequest s e
IgnoreParentEvents]
      wheelCfg :: Rational
wheelCfg = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasScrollWheelRate s a => Lens' s a
L.scrollWheelRate) (forall s e. ScrollCfg s e -> Maybe Rational
_scWheelRate ScrollCfg s e
config)
      wheelRate :: Double
wheelRate = forall a. Fractional a => Rational -> a
fromRational Rational
wheelCfg

  scrollAxis :: a -> a -> a -> a
scrollAxis a
reqDelta a
childLength a
vpLength
    | a
maxDelta forall a. Eq a => a -> a -> Bool
== a
0 = a
0
    | a
reqDelta forall a. Ord a => a -> a -> Bool
< a
0 = forall a. Ord a => a -> a -> a
max a
reqDelta (-a
maxDelta)
    | Bool
otherwise = forall a. Ord a => a -> a -> a
min a
reqDelta a
0
    where
      maxDelta :: a
maxDelta = forall a. Ord a => a -> a -> a
max a
0 (a
childLength forall a. Num a => a -> a -> a
- a
vpLength)
  scrollAxisH :: Double -> Double
scrollAxisH Double
delta = forall {a}. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
delta Double
childWidth Double
maxVpW
  scrollAxisV :: Double -> Double
scrollAxisV Double
delta = 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 -> p -> Maybe (WidgetResult s e)
handleMessage WidgetEnv s e
wenv WidgetNode s e
node p
target p
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 = 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 = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
message 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 = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
    contentArea :: Rect
contentArea = 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
    childVp :: Rect
childVp = Double -> Double -> Double -> Double -> Rect
Rect Double
cx Double
cy Double
maxVpW Double
maxVpH

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

    stepX :: Double
stepX
      | Rect -> Rect -> Bool
rectInRectH Rect
rect Rect
childVp = Double
dx
      | forall a. Num a => a -> a
abs Double
diffL forall a. Ord a => a -> a -> Bool
<= forall a. Num a => a -> a
abs Double
diffR = Double
diffL forall a. Num a => a -> a -> a
+ Double
dx
      | Bool
otherwise = Double
diffR forall a. Num a => a -> a -> a
+ Double
dx
    stepY :: Double
stepY
      | Rect -> Rect -> Bool
rectInRectV Rect
rect Rect
childVp = Double
dy
      | forall a. Num a => a -> a
abs Double
diffT forall a. Ord a => a -> a -> Bool
<= forall a. Num a => a -> a
abs Double
diffB = Double
diffT forall a. Num a => a -> a -> a
+ Double
dy
      | Bool
otherwise = Double
diffB 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
childVp = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
vThumbRatio :: Double
hThumbRatio :: 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
vThumbRatio :: ScrollContext -> Double
hThumbRatio :: ScrollContext -> Double
..} = ScrollContext
sctx
    Rect Double
cx Double
cy Double
_ Double
_ = Rect
contentArea

    (Double
offsetH, Double
offsetV) = (ScrollState -> Double
_sstThumbOffsetX ScrollState
state, ScrollState -> Double
_sstThumbOffsetY ScrollState
state)

    hDelta :: Double
hDelta = (Double
cx forall a. Num a => a -> a -> a
- Double
px forall a. Num a => a -> a -> a
+ Double
offsetH) forall a. Fractional a => a -> a -> a
/ Double
hThumbRatio
    vDelta :: Double
vDelta = (Double
cy forall a. Num a => a -> a -> a
- Double
py forall a. Num a => a -> a -> a
+ Double
offsetV) forall a. Fractional a => a -> a -> a
/ Double
vThumbRatio

    newDeltaX :: Double
newDeltaX
      | ActiveBar
activeBar forall a. Eq a => a -> a -> Bool
== ActiveBar
HBar = Double -> Double
scrollAxisH Double
hDelta
      | Bool
otherwise = Double
dx
    newDeltaY :: Double
newDeltaY
      | ActiveBar
activeBar 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
    updateReqs :: [WidgetRequest s e]
updateReqs
      | ScrollState -> ScrollState -> Bool
childPosChanged ScrollState
state ScrollState
newState = forall s e.
WidgetNode s e
-> ScrollCfg s e -> ScrollState -> [WidgetRequest s e]
scrollInfoReqs WidgetNode s e
node ScrollCfg s e
config ScrollState
newState
      | Bool
otherwise = []

    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
newState
    result :: WidgetResult s e
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode
      forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
updateReqs

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

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

    Size Double
w Double
h = forall a. a -> Maybe a -> a
fromMaybe 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 = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
    style :: StyleState
style = 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 = forall a. a -> Maybe a -> a
fromMaybe 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 = forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
0
    childW :: Double
childW = SizeReq -> Double
sizeReqMaxBounded forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    childH :: Double
childH = SizeReq -> Double
sizeReqMaxBounded forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH

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

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

    newDx :: Double
newDx = forall {a}. (Ord a, Num a) => a -> a -> a -> a
scrollAxis Double
dx Double
areaW Double
maxW
    newDy :: Double
newDy = 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 :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. ScrollCfg s e -> ScrollState -> Widget s e
makeScroll ScrollCfg s e
config ScrollState
newState
      -- For scrollInfoReqs only, since parent will set viewport later
      forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
viewport

    updateReqs :: [WidgetRequest s e]
updateReqs
      | ScrollState -> ScrollState -> Bool
childPosChanged ScrollState
state ScrollState
newState = forall s e.
WidgetNode s e
-> ScrollCfg s e -> ScrollState -> [WidgetRequest s e]
scrollInfoReqs WidgetNode s e
newNode ScrollCfg s e
config ScrollState
newState
      | Bool
otherwise = []
    visibleResult :: WidgetResult s e
visibleResult = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode
      forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
updateReqs

    result :: (WidgetResult s e, Seq Rect)
result
      | WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible = (WidgetResult s e
visibleResult, forall a. a -> Seq a
Seq.singleton Rect
cViewport)
      | Bool
otherwise = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hScrollRequired forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
hScrollRect Maybe Color
barColorH forall a. Maybe a
Nothing

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

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hScrollRequired 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

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
vScrollRequired 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
vThumbRatio :: Double
hThumbRatio :: 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
vThumbRatio :: ScrollContext -> Double
hThumbRatio :: ScrollContext -> Double
..} = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos

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

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

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

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

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

childPosChanged :: ScrollState -> ScrollState -> Bool
childPosChanged :: ScrollState -> ScrollState -> Bool
childPosChanged ScrollState
state ScrollState
newState = ScrollState -> Size
_sstVpSize ScrollState
state forall a. Eq a => a -> a -> Bool
/= ScrollState -> Size
_sstVpSize ScrollState
newState
  Bool -> Bool -> Bool
|| ScrollState -> Size
_sstChildSize ScrollState
state forall a. Eq a => a -> a -> Bool
/= ScrollState -> Size
_sstChildSize ScrollState
newState
  Bool -> Bool -> Bool
|| ScrollState -> Double
_sstDeltaX ScrollState
state forall a. Eq a => a -> a -> Bool
/= ScrollState -> Double
_sstDeltaX ScrollState
newState
  Bool -> Bool -> Bool
|| ScrollState -> Double
_sstDeltaY ScrollState
state forall a. Eq a => a -> a -> Bool
/= ScrollState -> Double
_sstDeltaY ScrollState
newState

scrollInfoReqs
  :: WidgetNode s e
  -> ScrollCfg s e
  -> ScrollState
  -> [WidgetRequest s e]
scrollInfoReqs :: forall s e.
WidgetNode s e
-> ScrollCfg s e -> ScrollState -> [WidgetRequest s e]
scrollInfoReqs WidgetNode s e
node ScrollCfg s e
config ScrollState
state = [WidgetRequest s e]
reqs where
  info :: ScrollStatus
info = ScrollStatus {
    scrollDeltaX :: Double
scrollDeltaX = ScrollState -> Double
_sstDeltaX ScrollState
state,
    scrollDeltaY :: Double
scrollDeltaY = ScrollState -> Double
_sstDeltaY ScrollState
state,
    scrollRect :: Rect
scrollRect = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport,
    scrollVpSize :: Size
scrollVpSize = ScrollState -> Size
_sstVpSize ScrollState
state,
    scrollChildSize :: Size
scrollChildSize = ScrollState -> Size
_sstChildSize ScrollState
state
  }
  reqs :: [WidgetRequest s e]
reqs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ ScrollStatus
info) (forall s e. ScrollCfg s e -> [ScrollStatus -> WidgetRequest s e]
_scOnChangeReq ScrollCfg s e
config)

scrollCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle :: forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
  | forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
child = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle WidgetEnv s e
wenv WidgetNode s e
node
  | Bool
otherwise = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  where
    child :: IxValue (Seq (WidgetNode s e))
child = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! 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 :: 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 = ScrollContext{Bool
Double
Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vThumbRatio :: Double
hThumbRatio :: Double
vScrollRequired :: Bool
hScrollRequired :: Bool
vThumbRect :: Rect
hThumbRect :: Rect
vScrollRect :: Rect
hScrollRect :: Rect
vMouseInThumb :: Bool
hMouseInThumb :: Bool
vMouseInScroll :: Bool
hMouseInScroll :: Bool
vScrollRequired :: Bool
hScrollRequired :: Bool
vThumbRatio :: Double
hThumbRatio :: Double
..} where
  (Maybe ActiveBar
dragging, Double
dx, Double
dy) = (ScrollState -> Maybe ActiveBar
_sstDragging ScrollState
state, ScrollState -> Double
_sstDeltaX ScrollState
state, ScrollState -> Double
_sstDeltaY ScrollState
state)

  Size Double
childWidth Double
childHeight = ScrollState -> Size
_sstChildSize ScrollState
state
  Size Double
vpWidth Double
vpHeight = ScrollState -> Size
_sstVpSize ScrollState
state

  theme :: ThemeState
theme = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
  style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
scrollCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
  contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style

  barW :: Double
barW = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasScrollBarWidth s a => Lens' s a
L.scrollBarWidth) (forall s e. ScrollCfg s e -> Maybe Double
_scBarWidth ScrollCfg s e
config)
  thumbW :: Double
thumbW = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasScrollThumbWidth s a => Lens' s a
L.scrollThumbWidth) (forall s e. ScrollCfg s e -> Maybe Double
_scThumbWidth ScrollCfg s e
config)
  minSize :: Double
minSize = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasScrollThumbMinSize s a => Lens' s a
L.scrollThumbMinSize) (forall s e. ScrollCfg s e -> Maybe Double
_scThumbMinSize 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 forall a. Num a => a -> a -> a
- Double
barW
  vScrollLeft :: Double
vScrollLeft = Double
caWidth forall a. Num a => a -> a -> a
- Double
barW

  hRatio :: Double
hRatio = Double
caWidth forall a. Fractional a => a -> a -> a
/ Double
childWidth
  vRatio :: Double
vRatio = Double
caHeight forall a. Fractional a => a -> a -> a
/ Double
childHeight

  ratioBarW :: Double
ratioBarW
    | Double
hRatio forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
&& Double
vRatio forall a. Ord a => a -> a -> Bool
< Double
1 = Double
barW
    | Bool
otherwise = Double
0
  hScrollRatio :: Double
hScrollRatio = (Double
caWidth forall a. Num a => a -> a -> a
- Double
ratioBarW) forall a. Fractional a => a -> a -> a
/ Double
childWidth
  vScrollRatio :: Double
vScrollRatio = (Double
caHeight forall a. Num a => a -> a -> a
- Double
ratioBarW) forall a. Fractional a => a -> a -> a
/ Double
childHeight

  hScrollRequired :: Bool
hScrollRequired = Double
hScrollRatio forall a. Ord a => a -> a -> Bool
< Double
1
  vScrollRequired :: Bool
vScrollRequired = Double
vScrollRatio forall a. Ord a => a -> a -> Bool
< Double
1

  hThumbSize :: Double
hThumbSize = forall a. Ord a => a -> a -> a
max Double
minSize (Double
hScrollRatio forall a. Num a => a -> a -> a
* Double
vpWidth)
  vThumbSize :: Double
vThumbSize = forall a. Ord a => a -> a -> a
max Double
minSize (Double
vScrollRatio forall a. Num a => a -> a -> a
* Double
vpHeight)

  hThumbArea :: Double
hThumbArea = Double
caWidth forall a. Num a => a -> a -> a
- Double
ratioBarW
  vThumbArea :: Double
vThumbArea = Double
caHeight forall a. Num a => a -> a -> a
- Double
ratioBarW
  hThumbRatio :: Double
hThumbRatio = (Double
hThumbArea forall a. Num a => a -> a -> a
- Double
hThumbSize) forall a. Fractional a => a -> a -> a
/ (Double
childWidth forall a. Num a => a -> a -> a
- Double
hThumbArea)
  vThumbRatio :: Double
vThumbRatio = (Double
vThumbArea forall a. Num a => a -> a -> a
- Double
vThumbSize) forall a. Fractional a => a -> a -> a
/ (Double
childHeight forall a. Num a => a -> a -> a
- Double
vThumbArea)

  hScrollRect :: Rect
hScrollRect = Rect {
    _rX :: Double
_rX = Double
caLeft,
    _rY :: Double
_rY = Double
caTop forall a. Num a => a -> a -> a
+ Double
hScrollTop,
    _rW :: Double
_rW = Double
vpWidth,
    _rH :: Double
_rH = Double
barW
  }
  vScrollRect :: Rect
vScrollRect = Rect {
    _rX :: Double
_rX = Double
caLeft 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 {
    _rX :: Double
_rX = Double
caLeft forall a. Num a => a -> a -> a
- Double
hThumbRatio forall a. Num a => a -> a -> a
* Double
dx,
    _rY :: Double
_rY = Double
caTop forall a. Num a => a -> a -> a
+ Double
hScrollTop forall a. Num a => a -> a -> a
+ (Double
barW forall a. Num a => a -> a -> a
- Double
thumbW) forall a. Fractional a => a -> a -> a
/ Double
2,
    _rW :: Double
_rW = Double
hThumbSize,
    _rH :: Double
_rH = Double
thumbW
  }
  vThumbRect :: Rect
vThumbRect = Rect {
    _rX :: Double
_rX = Double
caLeft forall a. Num a => a -> a -> a
+ Double
vScrollLeft forall a. Num a => a -> a -> a
+ (Double
barW forall a. Num a => a -> a -> a
- Double
thumbW) forall a. Fractional a => a -> a -> a
/ Double
2,
    _rY :: Double
_rY = Double
caTop forall a. Num a => a -> a -> a
- Double
vThumbRatio forall a. Num a => a -> a -> a
* Double
dy,
    _rW :: Double
_rW = Double
thumbW,
    _rH :: Double
_rH = Double
vThumbSize
  }

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