-- | Pure text-area geometry: the field box, content clip, and which scrollbars
-- show where for a given content extent.
module NanoUI.Frame.TextArea.Geometry
  ( textAreaLineHeight
  , textAreaFieldClip
  , textAreaBarLane
  , TextAreaBars (..)
  , textAreaBars
  , TextAreaScrollBarLayouts (..)
  , textAreaScrollBarLayouts
  , textAreaScrollBarLayout
  , textAreaHScrollBarLayout
  , isMouseOnTextAreaScrollBar
  ) where

import NanoUI.Font (FontMetrics (..), ScrollBarSlot (..), scrollBarGeomFor, scrollBarSideGap, widgetContentInset)
import NanoUI.Frame.Scroll.Geometry (ScrollBarLayout (..), scrollBarLayout, scrollChromeLane)
import NanoUI.Layout.Arena (DirTag (..))
import NanoUI.Style (Padding (..))
import NanoUI.Types (Rect (..), V2, onGrid, rectContains)

-- | Text area row height, snapped to the device pixel grid.
textAreaLineHeight :: FontMetrics -> Float
textAreaLineHeight :: FontMetrics -> Float
textAreaLineHeight FontMetrics
fm = Float -> Float -> Float
onGrid (FontMetrics -> Float
fmSnapScale FontMetrics
fm) (FontMetrics -> Float
fmLineHeight FontMetrics
fm)

-- | Text clip of a text area field. A caption-less text area's field is its
-- whole node rect.
textAreaFieldClip :: FontMetrics -> Rect -> Rect
textAreaFieldClip :: FontMetrics -> Rect -> Rect
textAreaFieldClip FontMetrics
fm (Rect Float
fx Float
fy Float
fw Float
fh) =
  let s :: Float
s = FontMetrics -> Float
fmSnapScale FontMetrics
fm
      (Float
ix, Float
iy) = FontMetrics -> (Float, Float)
widgetContentInset FontMetrics
fm
   in Float -> Float -> Float -> Float -> Rect
Rect (Float
fx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float -> Float
onGrid Float
s Float
ix) (Float
fy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float -> Float
onGrid Float
s Float
iy) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
fw Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ix)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
fh Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
iy))

-- | Width of the vertical and height of the horizontal scrollbar lane.
textAreaBarLane :: Float
textAreaBarLane :: Float
textAreaBarLane = (Float, Float) -> Float
forall a b. (a, b) -> a
fst (ScrollBarSlot -> (Float, Float)
scrollBarGeomFor ScrollBarSlot
ScrollBarList) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
scrollBarSideGap

-- | Which scrollbars a text area shows for its content extent, the text
-- viewport they leave, and the paddings that place each bar's lane.
data TextAreaBars = TextAreaBars
  { TextAreaBars -> Bool
tabVertical :: !Bool
  , TextAreaBars -> Bool
tabHorizontal :: !Bool
  , TextAreaBars -> Float
tabViewW :: !Float
  , TextAreaBars -> Float
tabViewH :: !Float
  , TextAreaBars -> Padding
tabPadV :: !Padding
  , TextAreaBars -> Padding
tabPadH :: !Padding
  }

textAreaBars :: FontMetrics -> Rect -> Float -> Float -> TextAreaBars
textAreaBars :: FontMetrics -> Rect -> Float -> Float -> TextAreaBars
textAreaBars FontMetrics
fm (Rect Float
_ Float
_ Float
fw Float
fh) Float
contentW Float
contentH =
  let (Float
ix, Float
iy) = FontMetrics -> (Float, Float)
widgetContentInset FontMetrics
fm
      innerW :: Float
innerW = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
fw Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ix)
      innerH :: Float
innerH = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
fh Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
iy)
      laneW :: Float
laneW = Float
textAreaBarLane
      laneH :: Float
laneH = Float
textAreaBarLane
      -- Either bar's lane can push the other axis into overflow.
      hasV :: Bool
hasV = Float
contentH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> (if Float
contentW Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
innerW then 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
laneH) else Float
innerH)
      hasH :: Bool
hasH = Float
contentW Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> (if Float
contentH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
innerH then 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
laneW) else Float
innerW)
   in TextAreaBars
        { tabVertical :: Bool
tabVertical = Bool
hasV
        , tabHorizontal :: Bool
tabHorizontal = Bool
hasH
        , tabViewW :: Float
tabViewW = if Bool
hasV then 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
laneW) else Float
innerW
        , tabViewH :: Float
tabViewH = if Bool
hasH then 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
laneH) else Float
innerH
        , tabPadV :: Padding
tabPadV = Float -> Float -> Float -> Float -> Padding
Padding Float
0 Float
0 Float
iy (if Bool
hasH then Float
iy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
laneH else Float
iy)
        , tabPadH :: Padding
tabPadH = Float -> Float -> Float -> Float -> Padding
Padding Float
ix (if Bool
hasV then Float
ix Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
laneW else Float
ix) Float
0 Float
0
        }

data TextAreaScrollBarLayouts = TextAreaScrollBarLayouts
  { TextAreaScrollBarLayouts -> Maybe ScrollBarLayout
tasbVertical :: !(Maybe ScrollBarLayout)
  , TextAreaScrollBarLayouts -> Maybe ScrollBarLayout
tasbHorizontal :: !(Maybe ScrollBarLayout)
  }
  deriving (TextAreaScrollBarLayouts -> TextAreaScrollBarLayouts -> Bool
(TextAreaScrollBarLayouts -> TextAreaScrollBarLayouts -> Bool)
-> (TextAreaScrollBarLayouts -> TextAreaScrollBarLayouts -> Bool)
-> Eq TextAreaScrollBarLayouts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextAreaScrollBarLayouts -> TextAreaScrollBarLayouts -> Bool
== :: TextAreaScrollBarLayouts -> TextAreaScrollBarLayouts -> Bool
$c/= :: TextAreaScrollBarLayouts -> TextAreaScrollBarLayouts -> Bool
/= :: TextAreaScrollBarLayouts -> TextAreaScrollBarLayouts -> Bool
Eq, Int -> TextAreaScrollBarLayouts -> ShowS
[TextAreaScrollBarLayouts] -> ShowS
TextAreaScrollBarLayouts -> String
(Int -> TextAreaScrollBarLayouts -> ShowS)
-> (TextAreaScrollBarLayouts -> String)
-> ([TextAreaScrollBarLayouts] -> ShowS)
-> Show TextAreaScrollBarLayouts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextAreaScrollBarLayouts -> ShowS
showsPrec :: Int -> TextAreaScrollBarLayouts -> ShowS
$cshow :: TextAreaScrollBarLayouts -> String
show :: TextAreaScrollBarLayouts -> String
$cshowList :: [TextAreaScrollBarLayouts] -> ShowS
showList :: [TextAreaScrollBarLayouts] -> ShowS
Show)

textAreaScrollBarLayouts :: FontMetrics -> Rect -> Float -> Float -> Float -> Float -> TextAreaScrollBarLayouts
textAreaScrollBarLayouts :: FontMetrics
-> Rect
-> Float
-> Float
-> Float
-> Float
-> TextAreaScrollBarLayouts
textAreaScrollBarLayouts FontMetrics
fm field :: Rect
field@(Rect Float
x Float
y Float
w Float
h) Float
contentW Float
contentH Float
scrollX Float
scrollY =
  let bars :: TextAreaBars
bars = FontMetrics -> Rect -> Float -> Float -> TextAreaBars
textAreaBars FontMetrics
fm Rect
field Float
contentW Float
contentH
      layout :: Bool
-> DirTag -> Padding -> Float -> Float -> Maybe ScrollBarLayout
layout Bool
shown DirTag
dir Padding
pad Float
content Float
off
        | Bool
shown = ScrollBarSlot
-> DirTag
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Maybe ScrollBarLayout
scrollBarLayout ScrollBarSlot
ScrollBarList DirTag
dir Float
x Float
y Float
w Float
h Padding
pad Float
content Float
off
        | Bool
otherwise = Maybe ScrollBarLayout
forall a. Maybe a
Nothing
   in TextAreaScrollBarLayouts
        { tasbVertical :: Maybe ScrollBarLayout
tasbVertical = Bool
-> DirTag -> Padding -> Float -> Float -> Maybe ScrollBarLayout
layout (TextAreaBars -> Bool
tabVertical TextAreaBars
bars) DirTag
DirColumn (TextAreaBars -> Padding
tabPadV TextAreaBars
bars) Float
contentH Float
scrollY
        , tasbHorizontal :: Maybe ScrollBarLayout
tasbHorizontal = Bool
-> DirTag -> Padding -> Float -> Float -> Maybe ScrollBarLayout
layout (TextAreaBars -> Bool
tabHorizontal TextAreaBars
bars) DirTag
DirRow (TextAreaBars -> Padding
tabPadH TextAreaBars
bars) Float
contentW Float
scrollX
        }

textAreaScrollBarLayout :: FontMetrics -> Rect -> Float -> Float -> Maybe ScrollBarLayout
textAreaScrollBarLayout :: FontMetrics -> Rect -> Float -> Float -> Maybe ScrollBarLayout
textAreaScrollBarLayout FontMetrics
fm Rect
field Float
contentH Float
scrollY =
  TextAreaScrollBarLayouts -> Maybe ScrollBarLayout
tasbVertical (FontMetrics
-> Rect
-> Float
-> Float
-> Float
-> Float
-> TextAreaScrollBarLayouts
textAreaScrollBarLayouts FontMetrics
fm Rect
field Float
0 Float
contentH Float
0 Float
scrollY)

textAreaHScrollBarLayout :: FontMetrics -> Rect -> Float -> Float -> Maybe ScrollBarLayout
textAreaHScrollBarLayout :: FontMetrics -> Rect -> Float -> Float -> Maybe ScrollBarLayout
textAreaHScrollBarLayout FontMetrics
fm Rect
field Float
contentW Float
scrollX =
  TextAreaScrollBarLayouts -> Maybe ScrollBarLayout
tasbHorizontal (FontMetrics
-> Rect
-> Float
-> Float
-> Float
-> Float
-> TextAreaScrollBarLayouts
textAreaScrollBarLayouts FontMetrics
fm Rect
field Float
contentW Float
0 Float
scrollX Float
0)

-- | Whether @mouse@ is over a shown bar's lane or track.
isMouseOnTextAreaScrollBar :: FontMetrics -> Rect -> Float -> Float -> Float -> Float -> V2 -> Bool
isMouseOnTextAreaScrollBar :: FontMetrics
-> Rect -> Float -> Float -> Float -> Float -> V2 -> Bool
isMouseOnTextAreaScrollBar FontMetrics
fm field :: Rect
field@(Rect Float
x Float
y Float
w Float
h) Float
contentW Float
contentH Float
scrollX Float
scrollY V2
mouse =
  let bars :: TextAreaBars
bars = FontMetrics -> Rect -> Float -> Float -> TextAreaBars
textAreaBars FontMetrics
fm Rect
field Float
contentW Float
contentH
      layouts :: TextAreaScrollBarLayouts
layouts = FontMetrics
-> Rect
-> Float
-> Float
-> Float
-> Float
-> TextAreaScrollBarLayouts
textAreaScrollBarLayouts FontMetrics
fm Rect
field Float
contentW Float
contentH Float
scrollX Float
scrollY
      onBar :: DirTag -> Padding -> Maybe ScrollBarLayout -> Bool
onBar DirTag
dir Padding
pad =
        Bool -> (ScrollBarLayout -> Bool) -> Maybe ScrollBarLayout -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((ScrollBarLayout -> Bool) -> Maybe ScrollBarLayout -> Bool)
-> (ScrollBarLayout -> Bool) -> Maybe ScrollBarLayout -> Bool
forall a b. (a -> b) -> a -> b
$ \ScrollBarLayout
layout ->
          Rect -> V2 -> Bool
rectContains (ScrollBarSlot
-> DirTag -> Float -> Float -> Float -> Float -> Padding -> Rect
scrollChromeLane ScrollBarSlot
ScrollBarList DirTag
dir Float
x Float
y Float
w Float
h Padding
pad) V2
mouse
            Bool -> Bool -> Bool
|| Rect -> V2 -> Bool
rectContains (ScrollBarLayout -> Rect
sbTrack ScrollBarLayout
layout) V2
mouse
   in DirTag -> Padding -> Maybe ScrollBarLayout -> Bool
onBar DirTag
DirColumn (TextAreaBars -> Padding
tabPadV TextAreaBars
bars) (TextAreaScrollBarLayouts -> Maybe ScrollBarLayout
tasbVertical TextAreaScrollBarLayouts
layouts)
        Bool -> Bool -> Bool
|| DirTag -> Padding -> Maybe ScrollBarLayout -> Bool
onBar DirTag
DirRow (TextAreaBars -> Padding
tabPadH TextAreaBars
bars) (TextAreaScrollBarLayouts -> Maybe ScrollBarLayout
tasbHorizontal TextAreaScrollBarLayouts
layouts)