{-# LANGUAGE DataKinds #-}
module NanoUI.Frame.Scroll.Geometry
( ScrollPolicy (..)
, ScrollConfig (..)
, defaultScrollConfig
, ScrollBarLayout (..)
, scrollContentClip
, scrollViewportClip2D
, scrollChromeLane
, scrollBarLayout
, scrollBarLayouts2D
, scrollAxisRange
, scrollOffsetFromThumb
, padContentClip
, encodeScrollConfig
, decodeScrollConfig
, scrollConfigNative2D
, scrollDefault1D
, scrollVerticalAuto
, scrollVerticalHidden
, scrollHorizontalHidden
, scrollAxisGutter
, scrollGutters2D
, scrollChromeSuppressed
, scrollWheelSuppressed
, scrollLineFor
, scrollAxisOverflows
, scrollChromeActive
, isScrollStyle2D
, tagClippedSpans
, padTextClipRect
, borderContentClip
) where
import Data.Bits ((.&.), shiftL, shiftR)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import NanoUI.Font
( ScrollBarSlot (..)
, scrollBarGap
, scrollBarGeomFor
, scrollBarGutter
, scrollBarSideGap
, scrollLayoutGutter
)
import NanoUI.Types (Color, Rect (..), V2 (..), rectH, rectIntersect, rectW, rectX, rectY, v2X, v2Y)
import NanoUI.Layout.Arena (DirTag (..))
import NanoUI.Style (Direction (..), Padding (..), Style (..), styleBorderWidth, windowPad)
data ScrollPolicy
= ScrollAuto
| ScrollAlways
| ScrollNone
| ScrollHidden
deriving (ScrollPolicy -> ScrollPolicy -> Bool
(ScrollPolicy -> ScrollPolicy -> Bool)
-> (ScrollPolicy -> ScrollPolicy -> Bool) -> Eq ScrollPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScrollPolicy -> ScrollPolicy -> Bool
== :: ScrollPolicy -> ScrollPolicy -> Bool
$c/= :: ScrollPolicy -> ScrollPolicy -> Bool
/= :: ScrollPolicy -> ScrollPolicy -> Bool
Eq, Int -> ScrollPolicy -> ShowS
[ScrollPolicy] -> ShowS
ScrollPolicy -> String
(Int -> ScrollPolicy -> ShowS)
-> (ScrollPolicy -> String)
-> ([ScrollPolicy] -> ShowS)
-> Show ScrollPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScrollPolicy -> ShowS
showsPrec :: Int -> ScrollPolicy -> ShowS
$cshow :: ScrollPolicy -> String
show :: ScrollPolicy -> String
$cshowList :: [ScrollPolicy] -> ShowS
showList :: [ScrollPolicy] -> ShowS
Show, Int -> ScrollPolicy
ScrollPolicy -> Int
ScrollPolicy -> [ScrollPolicy]
ScrollPolicy -> ScrollPolicy
ScrollPolicy -> ScrollPolicy -> [ScrollPolicy]
ScrollPolicy -> ScrollPolicy -> ScrollPolicy -> [ScrollPolicy]
(ScrollPolicy -> ScrollPolicy)
-> (ScrollPolicy -> ScrollPolicy)
-> (Int -> ScrollPolicy)
-> (ScrollPolicy -> Int)
-> (ScrollPolicy -> [ScrollPolicy])
-> (ScrollPolicy -> ScrollPolicy -> [ScrollPolicy])
-> (ScrollPolicy -> ScrollPolicy -> [ScrollPolicy])
-> (ScrollPolicy -> ScrollPolicy -> ScrollPolicy -> [ScrollPolicy])
-> Enum ScrollPolicy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ScrollPolicy -> ScrollPolicy
succ :: ScrollPolicy -> ScrollPolicy
$cpred :: ScrollPolicy -> ScrollPolicy
pred :: ScrollPolicy -> ScrollPolicy
$ctoEnum :: Int -> ScrollPolicy
toEnum :: Int -> ScrollPolicy
$cfromEnum :: ScrollPolicy -> Int
fromEnum :: ScrollPolicy -> Int
$cenumFrom :: ScrollPolicy -> [ScrollPolicy]
enumFrom :: ScrollPolicy -> [ScrollPolicy]
$cenumFromThen :: ScrollPolicy -> ScrollPolicy -> [ScrollPolicy]
enumFromThen :: ScrollPolicy -> ScrollPolicy -> [ScrollPolicy]
$cenumFromTo :: ScrollPolicy -> ScrollPolicy -> [ScrollPolicy]
enumFromTo :: ScrollPolicy -> ScrollPolicy -> [ScrollPolicy]
$cenumFromThenTo :: ScrollPolicy -> ScrollPolicy -> ScrollPolicy -> [ScrollPolicy]
enumFromThenTo :: ScrollPolicy -> ScrollPolicy -> ScrollPolicy -> [ScrollPolicy]
Enum, ScrollPolicy
ScrollPolicy -> ScrollPolicy -> Bounded ScrollPolicy
forall a. a -> a -> Bounded a
$cminBound :: ScrollPolicy
minBound :: ScrollPolicy
$cmaxBound :: ScrollPolicy
maxBound :: ScrollPolicy
Bounded)
data ScrollConfig = ScrollConfig
{ ScrollConfig -> ScrollPolicy
scrollPolicyX :: !ScrollPolicy
, ScrollConfig -> ScrollPolicy
scrollPolicyY :: !ScrollPolicy
, ScrollConfig -> Bool
scrollClamp :: !Bool
, ScrollConfig -> Bool
scrollBare :: !Bool
}
deriving (ScrollConfig -> ScrollConfig -> Bool
(ScrollConfig -> ScrollConfig -> Bool)
-> (ScrollConfig -> ScrollConfig -> Bool) -> Eq ScrollConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScrollConfig -> ScrollConfig -> Bool
== :: ScrollConfig -> ScrollConfig -> Bool
$c/= :: ScrollConfig -> ScrollConfig -> Bool
/= :: ScrollConfig -> ScrollConfig -> Bool
Eq, Int -> ScrollConfig -> ShowS
[ScrollConfig] -> ShowS
ScrollConfig -> String
(Int -> ScrollConfig -> ShowS)
-> (ScrollConfig -> String)
-> ([ScrollConfig] -> ShowS)
-> Show ScrollConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScrollConfig -> ShowS
showsPrec :: Int -> ScrollConfig -> ShowS
$cshow :: ScrollConfig -> String
show :: ScrollConfig -> String
$cshowList :: [ScrollConfig] -> ShowS
showList :: [ScrollConfig] -> ShowS
Show)
defaultScrollConfig :: ScrollConfig
defaultScrollConfig :: ScrollConfig
defaultScrollConfig =
ScrollConfig
{ scrollPolicyX :: ScrollPolicy
scrollPolicyX = ScrollPolicy
ScrollAuto
, scrollPolicyY :: ScrollPolicy
scrollPolicyY = ScrollPolicy
ScrollAuto
, scrollClamp :: Bool
scrollClamp = Bool
True
, scrollBare :: Bool
scrollBare = Bool
False
}
scrollConfigNative2D :: ScrollConfig -> Bool
scrollConfigNative2D :: ScrollConfig -> Bool
scrollConfigNative2D ScrollConfig
cfg =
ScrollPolicy -> Bool
scrollAxisActive (ScrollConfig -> ScrollPolicy
scrollPolicyX ScrollConfig
cfg) Bool -> Bool -> Bool
&& ScrollPolicy -> Bool
scrollAxisActive (ScrollConfig -> ScrollPolicy
scrollPolicyY ScrollConfig
cfg)
where
scrollAxisActive :: ScrollPolicy -> Bool
scrollAxisActive = \case
ScrollPolicy
ScrollNone -> Bool
False
ScrollPolicy
_ -> Bool
True
encodeScrollConfig :: ScrollConfig -> Int
encodeScrollConfig :: ScrollConfig -> Int
encodeScrollConfig ScrollConfig
cfg =
ScrollPolicy -> Int
policyBits (ScrollConfig -> ScrollPolicy
scrollPolicyX ScrollConfig
cfg)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL (ScrollPolicy -> Int
policyBits (ScrollConfig -> ScrollPolicy
scrollPolicyY ScrollConfig
cfg)) Int
2
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if ScrollConfig -> Bool
scrollClamp ScrollConfig
cfg then Int
16 else Int
0)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if ScrollConfig -> Bool
scrollBare ScrollConfig
cfg then Int
32 else Int
0)
where
policyBits :: ScrollPolicy -> Int
policyBits = \case
ScrollPolicy
ScrollAuto -> Int
0
ScrollPolicy
ScrollAlways -> Int
1
ScrollPolicy
ScrollNone -> Int
2
ScrollPolicy
ScrollHidden -> Int
3
decodeScrollConfig :: Int -> ScrollConfig
decodeScrollConfig :: Int -> ScrollConfig
decodeScrollConfig Int
bits =
ScrollConfig
{ scrollPolicyX :: ScrollPolicy
scrollPolicyX = Int -> ScrollPolicy
forall {a}. (Eq a, Num a) => a -> ScrollPolicy
decodePolicy (Int
bits Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
3)
, scrollPolicyY :: ScrollPolicy
scrollPolicyY = Int -> ScrollPolicy
forall {a}. (Eq a, Num a) => a -> ScrollPolicy
decodePolicy (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
bits Int
2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
3)
, scrollClamp :: Bool
scrollClamp = Int
bits Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
16 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
, scrollBare :: Bool
scrollBare = Int
bits Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
32 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
}
where
decodePolicy :: a -> ScrollPolicy
decodePolicy a
1 = ScrollPolicy
ScrollAlways
decodePolicy a
2 = ScrollPolicy
ScrollNone
decodePolicy a
3 = ScrollPolicy
ScrollHidden
decodePolicy a
_ = ScrollPolicy
ScrollAuto
scrollDefault1D :: Direction -> ScrollConfig
scrollDefault1D :: Direction -> ScrollConfig
scrollDefault1D Direction
Column = ScrollConfig
scrollVerticalAuto
scrollDefault1D Direction
Row = ScrollConfig
scrollHorizontalAuto
scrollVerticalAuto :: ScrollConfig
scrollVerticalAuto :: ScrollConfig
scrollVerticalAuto = ScrollPolicy -> ScrollPolicy -> Bool -> Bool -> ScrollConfig
ScrollConfig ScrollPolicy
ScrollNone ScrollPolicy
ScrollAuto Bool
True Bool
False
scrollHorizontalAuto :: ScrollConfig
scrollHorizontalAuto :: ScrollConfig
scrollHorizontalAuto = ScrollPolicy -> ScrollPolicy -> Bool -> Bool -> ScrollConfig
ScrollConfig ScrollPolicy
ScrollAuto ScrollPolicy
ScrollNone Bool
True Bool
False
scrollVerticalHidden :: ScrollConfig
scrollVerticalHidden :: ScrollConfig
scrollVerticalHidden = ScrollPolicy -> ScrollPolicy -> Bool -> Bool -> ScrollConfig
ScrollConfig ScrollPolicy
ScrollNone ScrollPolicy
ScrollHidden Bool
True Bool
False
scrollHorizontalHidden :: ScrollConfig
scrollHorizontalHidden :: ScrollConfig
scrollHorizontalHidden = ScrollPolicy -> ScrollPolicy -> Bool -> Bool -> ScrollConfig
ScrollConfig ScrollPolicy
ScrollHidden ScrollPolicy
ScrollNone Bool
True Bool
False
scrollAxisGutter ::
ScrollPolicy ->
ScrollBarSlot ->
Float ->
Float ->
Float ->
Float
scrollAxisGutter :: ScrollPolicy -> ScrollBarSlot -> Float -> Float -> Float -> Float
scrollAxisGutter ScrollPolicy
policy ScrollBarSlot
slot Float
trailPad Float
contentSize Float
innerMain =
case ScrollPolicy
policy of
ScrollPolicy
ScrollNone -> Float
0
ScrollPolicy
ScrollHidden -> Float
0
ScrollPolicy
ScrollAuto -> ScrollBarSlot -> Float -> Float -> Float -> Float
scrollLayoutGutter ScrollBarSlot
slot Float
trailPad Float
contentSize Float
innerMain
ScrollPolicy
ScrollAlways -> ScrollBarSlot -> Float -> Float
scrollBarGutter ScrollBarSlot
slot Float
trailPad
scrollGutters2D ::
ScrollBarSlot ->
ScrollConfig ->
Padding ->
Float ->
Float ->
Float ->
Float ->
(Float, Float)
scrollGutters2D :: ScrollBarSlot
-> ScrollConfig
-> Padding
-> Float
-> Float
-> Float
-> Float
-> (Float, Float)
scrollGutters2D ScrollBarSlot
slot ScrollConfig
cfg Padding
pad Float
contentW Float
contentH Float
innerW Float
innerH =
let gVert :: Float -> Float
gVert Float
inner = ScrollPolicy -> ScrollBarSlot -> Float -> Float -> Float -> Float
scrollAxisGutter (ScrollConfig -> ScrollPolicy
scrollPolicyY ScrollConfig
cfg) ScrollBarSlot
slot (Padding -> Float
padR Padding
pad) Float
contentH Float
inner
gHorz :: Float -> Float
gHorz Float
inner = ScrollPolicy -> ScrollBarSlot -> Float -> Float -> Float -> Float
scrollAxisGutter (ScrollConfig -> ScrollPolicy
scrollPolicyX ScrollConfig
cfg) ScrollBarSlot
slot (Padding -> Float
padB Padding
pad) Float
contentW Float
inner
gW0 :: Float
gW0 = Float -> Float
gVert Float
innerH
gH0 :: Float
gH0 = Float -> Float
gHorz Float
innerW
gW :: Float
gW = Float -> Float
gVert (Float
innerH Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
gH0)
gH :: Float
gH = Float -> Float
gHorz (Float
innerW Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
gW0)
in (Float
gW, Float
gH)
isScrollStyle2D :: Int -> Bool
isScrollStyle2D :: Int -> Bool
isScrollStyle2D Int
si = Int
si Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& ScrollConfig -> Bool
scrollConfigNative2D (Int -> ScrollConfig
decodeScrollConfig Int
si)
scrollShowsChrome :: ScrollConfig -> DirTag -> Bool
scrollShowsChrome :: ScrollConfig -> DirTag -> Bool
scrollShowsChrome ScrollConfig
cfg DirTag
dir =
case DirTag
dir of
DirTag
DirColumn -> ScrollPolicy -> Bool
axisShows (ScrollConfig -> ScrollPolicy
scrollPolicyY ScrollConfig
cfg)
DirTag
DirRow -> ScrollPolicy -> Bool
axisShows (ScrollConfig -> ScrollPolicy
scrollPolicyX ScrollConfig
cfg)
where
axisShows :: ScrollPolicy -> Bool
axisShows = \case
ScrollPolicy
ScrollAuto -> Bool
True
ScrollPolicy
ScrollAlways -> Bool
True
ScrollPolicy
_ -> Bool
False
scrollChromeSuppressed :: ScrollConfig -> DirTag -> Bool
scrollChromeSuppressed :: ScrollConfig -> DirTag -> Bool
scrollChromeSuppressed ScrollConfig
cfg DirTag
dir = Bool -> Bool
not (ScrollConfig -> DirTag -> Bool
scrollShowsChrome ScrollConfig
cfg DirTag
dir)
scrollLineFor :: Float
scrollLineFor :: Float
scrollLineFor = Float
20
scrollWheelSuppressed :: ScrollConfig -> Bool -> DirTag -> Bool
scrollWheelSuppressed :: ScrollConfig -> Bool -> DirTag -> Bool
scrollWheelSuppressed ScrollConfig
cfg Bool
native2D DirTag
dir =
Bool -> Bool
not Bool
native2D
Bool -> Bool -> Bool
&& ( case DirTag
dir of
DirTag
DirColumn -> ScrollConfig -> ScrollPolicy
scrollPolicyY ScrollConfig
cfg ScrollPolicy -> ScrollPolicy -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollPolicy
ScrollNone
DirTag
DirRow -> ScrollConfig -> ScrollPolicy
scrollPolicyX ScrollConfig
cfg ScrollPolicy -> ScrollPolicy -> Bool
forall a. Eq a => a -> a -> Bool
== ScrollPolicy
ScrollNone
)
scrollAxisOverflows :: ScrollPolicy -> Float -> Float -> Bool
scrollAxisOverflows :: ScrollPolicy -> Float -> Float -> Bool
scrollAxisOverflows ScrollPolicy
policy Float
contentSize Float
innerMain =
case ScrollPolicy
policy of
ScrollPolicy
ScrollNone -> Bool
False
ScrollPolicy
ScrollHidden -> Bool
False
ScrollPolicy
ScrollAlways -> Bool
True
ScrollPolicy
ScrollAuto -> Float
contentSize Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
innerMain Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5
scrollAxisRange :: Float -> Float -> Float -> Float
scrollAxisRange :: Float -> Float -> Float -> Float
scrollAxisRange Float
contentSize Float
innerMain Float
trailingPad
| Float
contentSize Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
innerMain Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5 = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
contentSize Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
trailingPad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
innerMain)
| Bool
otherwise = Float
0
scrollChromeActive :: ScrollConfig -> DirTag -> Float -> Float -> Bool
scrollChromeActive :: ScrollConfig -> DirTag -> Float -> Float -> Bool
scrollChromeActive ScrollConfig
cfg DirTag
dir Float
contentSize Float
innerMain =
ScrollConfig -> DirTag -> Bool
scrollShowsChrome ScrollConfig
cfg DirTag
dir
Bool -> Bool -> Bool
&& ScrollPolicy -> Float -> Float -> Bool
scrollAxisOverflows
(case DirTag
dir of
DirTag
DirColumn -> ScrollConfig -> ScrollPolicy
scrollPolicyY ScrollConfig
cfg
DirTag
DirRow -> ScrollConfig -> ScrollPolicy
scrollPolicyX ScrollConfig
cfg)
Float
contentSize
Float
innerMain
data ScrollBarLayout = ScrollBarLayout
{ ScrollBarLayout -> Rect
sbTrack :: Rect
, ScrollBarLayout -> Rect
sbThumb :: Rect
, ScrollBarLayout -> Float
sbMaxOff :: Float
}
deriving (ScrollBarLayout -> ScrollBarLayout -> Bool
(ScrollBarLayout -> ScrollBarLayout -> Bool)
-> (ScrollBarLayout -> ScrollBarLayout -> Bool)
-> Eq ScrollBarLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScrollBarLayout -> ScrollBarLayout -> Bool
== :: ScrollBarLayout -> ScrollBarLayout -> Bool
$c/= :: ScrollBarLayout -> ScrollBarLayout -> Bool
/= :: ScrollBarLayout -> ScrollBarLayout -> Bool
Eq, Int -> ScrollBarLayout -> ShowS
[ScrollBarLayout] -> ShowS
ScrollBarLayout -> String
(Int -> ScrollBarLayout -> ShowS)
-> (ScrollBarLayout -> String)
-> ([ScrollBarLayout] -> ShowS)
-> Show ScrollBarLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScrollBarLayout -> ShowS
showsPrec :: Int -> ScrollBarLayout -> ShowS
$cshow :: ScrollBarLayout -> String
show :: ScrollBarLayout -> String
$cshowList :: [ScrollBarLayout] -> ShowS
showList :: [ScrollBarLayout] -> ShowS
Show)
padContentClip :: Float -> Float -> Float -> Float -> Padding -> Rect
padContentClip :: Float -> Float -> Float -> Float -> Padding -> Rect
padContentClip Float
x Float
y Float
w Float
h Padding
pad =
Float -> Float -> Float -> Float -> Rect
Rect
(Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Padding -> Float
padL Padding
pad)
(Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Padding -> Float
padT Padding
pad)
(Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padL Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padR Padding
pad))
(Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padT Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padB Padding
pad))
scrollContentClip ::
ScrollBarSlot ->
ScrollConfig ->
DirTag ->
Float ->
Float ->
Float ->
Float ->
Padding ->
Float ->
Rect
scrollContentClip :: ScrollBarSlot
-> ScrollConfig
-> DirTag
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Rect
scrollContentClip ScrollBarSlot
slot ScrollConfig
cfg DirTag
dir Float
x Float
y Float
w Float
h Padding
pad Float
contentSize =
let base :: Rect
base = Float -> Float -> Float -> Float -> Padding -> Rect
padContentClip Float
x Float
y Float
w Float
h Padding
pad
innerMain :: Float
innerMain =
case DirTag
dir of
DirTag
DirColumn -> Rect -> Float
rectH Rect
base
DirTag
DirRow -> Rect -> Float
rectW Rect
base
(ScrollPolicy
policy, Float
trailPad) =
case DirTag
dir of
DirTag
DirColumn -> (ScrollConfig -> ScrollPolicy
scrollPolicyY ScrollConfig
cfg, Padding -> Float
padR Padding
pad)
DirTag
DirRow -> (ScrollConfig -> ScrollPolicy
scrollPolicyX ScrollConfig
cfg, Padding -> Float
padB Padding
pad)
gutter :: Float
gutter = ScrollPolicy -> ScrollBarSlot -> Float -> Float -> Float -> Float
scrollAxisGutter ScrollPolicy
policy ScrollBarSlot
slot Float
trailPad Float
contentSize Float
innerMain
in case DirTag
dir of
DirTag
DirColumn -> Float -> Float -> Float -> Float -> Rect
Rect (Rect -> Float
rectX Rect
base) (Rect -> Float
rectY Rect
base) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Rect -> Float
rectW Rect
base Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
gutter)) (Rect -> Float
rectH Rect
base)
DirTag
DirRow -> Float -> Float -> Float -> Float -> Rect
Rect (Rect -> Float
rectX Rect
base) (Rect -> Float
rectY Rect
base) (Rect -> Float
rectW Rect
base) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Rect -> Float
rectH Rect
base Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
gutter))
scrollViewportClip2D ::
ScrollBarSlot ->
ScrollConfig ->
Float ->
Float ->
Float ->
Float ->
Padding ->
Float ->
Float ->
Rect
scrollViewportClip2D :: ScrollBarSlot
-> ScrollConfig
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Rect
scrollViewportClip2D ScrollBarSlot
slot ScrollConfig
cfg Float
x Float
y Float
w Float
h Padding
pad Float
contentW Float
contentH =
let base :: Rect
base = Float -> Float -> Float -> Float -> Padding -> Rect
padContentClip Float
x Float
y Float
w Float
h Padding
pad
innerW :: Float
innerW = Rect -> Float
rectW Rect
base
innerH :: Float
innerH = Rect -> Float
rectH Rect
base
(Float
gutterW, Float
gutterH) = ScrollBarSlot
-> ScrollConfig
-> Padding
-> Float
-> Float
-> Float
-> Float
-> (Float, Float)
scrollGutters2D ScrollBarSlot
slot ScrollConfig
cfg Padding
pad Float
contentW Float
contentH Float
innerW Float
innerH
in Float -> Float -> Float -> Float -> Rect
Rect (Rect -> Float
rectX Rect
base) (Rect -> Float
rectY Rect
base) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
innerW Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
gutterW)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
innerH Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
gutterH))
scrollChromeLane ::
ScrollBarSlot -> DirTag -> Float -> Float -> Float -> Float -> Padding -> Rect
scrollChromeLane :: ScrollBarSlot
-> DirTag -> Float -> Float -> Float -> Float -> Padding -> Rect
scrollChromeLane ScrollBarSlot
slot DirTag
dir Float
x Float
y Float
w Float
h Padding
pad =
let (Float
barW, Float
_) = ScrollBarSlot -> (Float, Float)
scrollBarGeomFor ScrollBarSlot
slot
inset :: Float -> Float
inset Float
trailPad = case ScrollBarSlot
slot of
ScrollBarSlot
ScrollBarList -> Float -> Float
scrollBarGap Float
trailPad
ScrollBarSlot
ScrollBarPage -> Float
scrollBarSideGap
ScrollBarSlot
ScrollBarWindow -> Float
scrollBarSideGap Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padR Padding
windowPad
in case DirTag
dir of
DirTag
DirColumn ->
Float -> Float -> Float -> Float -> Rect
Rect (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
inset (Padding -> Float
padR Padding
pad) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
barW)) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Padding -> Float
padT Padding
pad) Float
barW (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padT Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padB Padding
pad))
DirTag
DirRow ->
Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Padding -> Float
padL Padding
pad) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
y (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
inset (Padding -> Float
padB Padding
pad) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
barW)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padL Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padR Padding
pad)) Float
barW
scrollBarLayout ::
ScrollBarSlot ->
DirTag ->
Float ->
Float ->
Float ->
Float ->
Padding ->
Float ->
Float ->
Maybe ScrollBarLayout
scrollBarLayout :: ScrollBarSlot
-> DirTag
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Maybe ScrollBarLayout
scrollBarLayout ScrollBarSlot
slot DirTag
dir Float
x Float
y Float
w Float
h Padding
pad Float
contentSize Float
off =
let innerW :: Float
innerW = Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padL Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padR Padding
pad
innerH :: Float
innerH = Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padT Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padB Padding
pad
viewMain :: Float
viewMain = case DirTag
dir of
DirTag
DirColumn -> Float
innerH
DirTag
DirRow -> Float
innerW
in ScrollBarSlot
-> DirTag
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Float
-> Maybe ScrollBarLayout
scrollBarLayoutIn ScrollBarSlot
slot DirTag
dir Float
x Float
y Float
w Float
h Padding
pad Float
viewMain Float
contentSize Float
off
scrollBarLayoutIn ::
ScrollBarSlot ->
DirTag ->
Float ->
Float ->
Float ->
Float ->
Padding ->
Float ->
Float ->
Float ->
Maybe ScrollBarLayout
scrollBarLayoutIn :: ScrollBarSlot
-> DirTag
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Float
-> Maybe ScrollBarLayout
scrollBarLayoutIn ScrollBarSlot
slot DirTag
dir Float
x Float
y Float
w Float
h Padding
pad Float
viewMain Float
contentSize Float
off =
let (Float
barW, Float
barMargin) = ScrollBarSlot -> (Float, Float)
scrollBarGeomFor ScrollBarSlot
slot
minThumb :: Float
minThumb = Float
16
in case DirTag
dir of
DirTag
DirColumn ->
let trailH :: Float
trailH = Padding -> Float
padB Padding
pad
extentH :: Float
extentH = Float
contentSize Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
trailH
maxOff :: Float
maxOff = Float -> Float -> Float -> Float
scrollAxisRange Float
contentSize Float
viewMain Float
trailH
in if Float
maxOff Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0
then Maybe ScrollBarLayout
forall a. Maybe a
Nothing
else
let lane :: Rect
lane = ScrollBarSlot
-> DirTag -> Float -> Float -> Float -> Float -> Padding -> Rect
scrollChromeLane ScrollBarSlot
slot DirTag
DirColumn Float
x Float
y Float
w Float
h Padding
pad
trackX :: Float
trackX = Rect -> Float
rectX Rect
lane
trackY :: Float
trackY = Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Padding -> Float
padT Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
barMargin
trackH :: Float
trackH = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
viewMain Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
barMargin)
thumbH :: Float
thumbH = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
minThumb (Float
trackH Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
viewMain Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
extentH)
ratio :: Float
ratio = Float
off Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxOff
thumbY :: Float
thumbY = Float
trackY Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ratio Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
trackH Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
thumbH)
in
ScrollBarLayout -> Maybe ScrollBarLayout
forall a. a -> Maybe a
Just
ScrollBarLayout
{ sbTrack :: Rect
sbTrack = Float -> Float -> Float -> Float -> Rect
Rect Float
trackX Float
trackY Float
barW Float
trackH
, sbThumb :: Rect
sbThumb = Float -> Float -> Float -> Float -> Rect
Rect Float
trackX Float
thumbY Float
barW Float
thumbH
, sbMaxOff :: Float
sbMaxOff = Float
maxOff
}
DirTag
DirRow ->
let trailW :: Float
trailW = Padding -> Float
padR Padding
pad
extentW :: Float
extentW = Float
contentSize Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
trailW
maxOff :: Float
maxOff = Float -> Float -> Float -> Float
scrollAxisRange Float
contentSize Float
viewMain Float
trailW
in if Float
maxOff Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0
then Maybe ScrollBarLayout
forall a. Maybe a
Nothing
else
let lane :: Rect
lane = ScrollBarSlot
-> DirTag -> Float -> Float -> Float -> Float -> Padding -> Rect
scrollChromeLane ScrollBarSlot
slot DirTag
DirRow Float
x Float
y Float
w Float
h Padding
pad
trackY :: Float
trackY = Rect -> Float
rectY Rect
lane
trackX :: Float
trackX = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Padding -> Float
padL Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
barMargin
trackW :: Float
trackW = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
viewMain Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
barMargin)
thumbW :: Float
thumbW = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
minThumb (Float
trackW Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
viewMain Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
extentW)
ratio :: Float
ratio = Float
off Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxOff
thumbX :: Float
thumbX = Float
trackX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ratio Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
trackW Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
thumbW)
in
ScrollBarLayout -> Maybe ScrollBarLayout
forall a. a -> Maybe a
Just
ScrollBarLayout
{ sbTrack :: Rect
sbTrack = Float -> Float -> Float -> Float -> Rect
Rect Float
trackX Float
trackY Float
trackW Float
barW
, sbThumb :: Rect
sbThumb = Float -> Float -> Float -> Float -> Rect
Rect Float
thumbX Float
trackY Float
thumbW Float
barW
, sbMaxOff :: Float
sbMaxOff = Float
maxOff
}
scrollBarLayouts2D ::
ScrollBarSlot ->
ScrollConfig ->
Float ->
Float ->
Float ->
Float ->
Padding ->
Float ->
Float ->
Float ->
Float ->
(Maybe ScrollBarLayout, Maybe ScrollBarLayout)
scrollBarLayouts2D :: ScrollBarSlot
-> ScrollConfig
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Float
-> Float
-> (Maybe ScrollBarLayout, Maybe ScrollBarLayout)
scrollBarLayouts2D ScrollBarSlot
slot ScrollConfig
cfg Float
x Float
y Float
w Float
h Padding
pad Float
contentW Float
contentH Float
offX Float
offY =
let innerW :: Float
innerW = Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padL Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padR Padding
pad
innerH :: Float
innerH = Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padT Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Padding -> Float
padB Padding
pad
(Float
gutterW, Float
gutterH) = ScrollBarSlot
-> ScrollConfig
-> Padding
-> Float
-> Float
-> Float
-> Float
-> (Float, Float)
scrollGutters2D ScrollBarSlot
slot ScrollConfig
cfg Padding
pad Float
contentW Float
contentH Float
innerW Float
innerH
viewW :: Float
viewW = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
innerW Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
gutterW)
viewH :: Float
viewH = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
innerH Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
gutterH)
v :: Maybe ScrollBarLayout
v = ScrollBarSlot
-> DirTag
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Float
-> Maybe ScrollBarLayout
scrollBarLayoutIn ScrollBarSlot
slot DirTag
DirColumn Float
x Float
y Float
w Float
h Padding
pad Float
viewH Float
contentH Float
offY
hr :: Maybe ScrollBarLayout
hr = ScrollBarSlot
-> DirTag
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Float
-> Maybe ScrollBarLayout
scrollBarLayoutIn ScrollBarSlot
slot DirTag
DirRow Float
x Float
y Float
w Float
h Padding
pad Float
viewW Float
contentW Float
offX
in (Maybe ScrollBarLayout
v, Maybe ScrollBarLayout
hr)
scrollOffsetFromThumb :: DirTag -> ScrollBarLayout -> Float -> V2 -> Float
scrollOffsetFromThumb :: DirTag -> ScrollBarLayout -> Float -> V2 -> Float
scrollOffsetFromThumb DirTag
dir ScrollBarLayout
layout Float
grabOff V2
mouse =
let maxOff :: Float
maxOff = ScrollBarLayout -> Float
sbMaxOff ScrollBarLayout
layout
track :: Rect
track = ScrollBarLayout -> Rect
sbTrack ScrollBarLayout
layout
thumb :: Rect
thumb = ScrollBarLayout -> Rect
sbThumb ScrollBarLayout
layout
in case DirTag
dir of
DirTag
DirColumn ->
let trackY :: Float
trackY = Rect -> Float
rectY Rect
track
trackH :: Float
trackH = Rect -> Float
rectH Rect
track
thumbH :: Float
thumbH = Rect -> Float
rectH Rect
thumb
thumbTop :: Float
thumbTop = V2 -> Float
v2Y V2
mouse Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
grabOff
ratio :: Float
ratio = (Float
thumbTop Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
trackY) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 (Float
trackH Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
thumbH)
in Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
maxOff (Float
ratio Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
maxOff))
DirTag
DirRow ->
let trackX :: Float
trackX = Rect -> Float
rectX Rect
track
trackW :: Float
trackW = Rect -> Float
rectW Rect
track
thumbW :: Float
thumbW = Rect -> Float
rectW Rect
thumb
thumbLeft :: Float
thumbLeft = V2 -> Float
v2X V2
mouse Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
grabOff
ratio :: Float
ratio = (Float
thumbLeft Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
trackX) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 (Float
trackW Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
thumbW)
in Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
maxOff (Float
ratio Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
maxOff))
textClipSlop :: Float
textClipSlop :: Float
textClipSlop = Float
4
tagClippedSpans :: Rect -> [(Rect, Text, Color, Color)] -> [(Rect, Text, Color, Color, Rect)]
tagClippedSpans :: Rect
-> [(Rect, Text, Color, Color)]
-> [(Rect, Text, Color, Color, Rect)]
tagClippedSpans Rect
clip =
((Rect, Text, Color, Color)
-> Maybe (Rect, Text, Color, Color, Rect))
-> [(Rect, Text, Color, Color)]
-> [(Rect, Text, Color, Color, Rect)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Rect
rect, Text
txt, Color
fg, Color
bg) -> (Rect
rect, Text
txt, Color
fg, Color
bg,) (Rect -> (Rect, Text, Color, Color, Rect))
-> Maybe Rect -> Maybe (Rect, Text, Color, Color, Rect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect -> Rect -> Maybe Rect
rectIntersect Rect
clip (Rect -> Rect
padTextClipRect Rect
rect))
padTextClipRect :: Rect -> Rect
padTextClipRect :: Rect -> Rect
padTextClipRect (Rect Float
x Float
y Float
w Float
h) = Float -> Float -> Float -> Float -> Rect
Rect Float
x Float
y (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
textClipSlop) Float
h
borderContentClip :: Style -> Rect -> Rect
borderContentClip :: Style -> Rect -> Rect
borderContentClip Style
style (Rect Float
x Float
y Float
w Float
h) =
if Style -> Float
styleBorderWidth Style
style Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0
then Float -> Float -> Float -> Float -> Rect
Rect Float
x Float
y Float
w Float
h
else
let bw :: Float
bw = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 (Style -> Float
styleBorderWidth Style
style)
in Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
bw) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
bw) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
bw)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
bw))