module Engine.UI.Layout.Linear
  ( hBoxShares
  , hBoxSplitRel

  , vBoxShares
  , vBoxSplitRel

  , placeBox
  , place

  , ranges
  , midpoints
  ) where

import RIO

import Data.Traversable (mapAccumL)
import Engine.UI.Layout qualified as Layout
import Geomancy (Vec2, vec2, withVec2, pattern WithVec2)

{-# INLINEABLE hBoxShares #-}
hBoxShares
  :: Traversable t
  => t Float
  -> Layout.Box
  -> t Layout.Box
hBoxShares :: forall (t :: * -> *). Traversable t => t Float -> Box -> t Box
hBoxShares t Float
items Box
parent = ((Float, Float) -> Box) -> t (Float, Float) -> t Box
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float, Float) -> Box
mkBox t (Float, Float)
ranges'
  where
    mkBox :: (Float, Float) -> Box
mkBox (Float
left, Float
right) = Box :: Vec2 -> Vec2 -> Box
Layout.Box
      { $sel:boxPosition:Box :: Vec2
boxPosition =
          Box -> Vec2
Layout.boxPosition Box
parent Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
+
          Float -> Float -> Vec2
vec2 (Float
midpoint Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
parentWidth Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5) Float
0
      , $sel:boxSize:Box :: Vec2
boxSize =
          Float -> Float -> Vec2
vec2 (Float
size Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale) Float
parentHeight
      }
      where
        size :: Float
size = Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
left
        midpoint :: Float
midpoint = Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
left Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5

    (Float
final, t (Float, Float)
ranges') = t Float -> (Float, t (Float, Float))
forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges t Float
items
    scale :: Float
scale = Float
parentWidth Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
final
    WithVec2 Float
parentWidth Float
parentHeight = Box -> Vec2
Layout.boxSize Box
parent

{-# INLINEABLE hBoxSplitRel #-}
hBoxSplitRel :: Float -> Layout.Box -> (Layout.Box, Layout.Box)
hBoxSplitRel :: Float -> Box -> (Box, Box)
hBoxSplitRel Float
alpha Box
parent =
  case forall (t :: * -> *). Traversable t => t Float -> Box -> t Box
hBoxShares @[] [Float
alpha, Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha] Box
parent of
    [Box
left, Box
right] ->
      (Box
left, Box
right)
    [Box]
_ ->
      [Char] -> (Box, Box)
forall a. HasCallStack => [Char] -> a
error [Char]
"requesting a pair"

{-# INLINEABLE vBoxShares #-}
vBoxShares
  :: Traversable t
  => t Float
  -> Layout.Box
  -> t Layout.Box
vBoxShares :: forall (t :: * -> *). Traversable t => t Float -> Box -> t Box
vBoxShares t Float
items Box
parent = ((Float, Float) -> Box) -> t (Float, Float) -> t Box
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float, Float) -> Box
mkBox t (Float, Float)
ranges'
  where
    mkBox :: (Float, Float) -> Box
mkBox (Float
top, Float
bottom) = Box :: Vec2 -> Vec2 -> Box
Layout.Box
      { $sel:boxPosition:Box :: Vec2
boxPosition =
          Box -> Vec2
Layout.boxPosition Box
parent Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
+
          Float -> Float -> Vec2
vec2 Float
0 (Float
midpoint Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
parentHeight Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5)
      , $sel:boxSize:Box :: Vec2
boxSize =
          Float -> Float -> Vec2
vec2 Float
parentWidth (Float
size Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale)
      }
      where
        size :: Float
size = Float
bottom Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
top
        midpoint :: Float
midpoint = Float
bottom Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5

    (Float
final, t (Float, Float)
ranges') = t Float -> (Float, t (Float, Float))
forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges t Float
items
    scale :: Float
scale = Float
parentHeight Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
final
    WithVec2 Float
parentWidth Float
parentHeight = Box -> Vec2
Layout.boxSize Box
parent

{-# INLINEABLE vBoxSplitRel #-}
vBoxSplitRel :: Float -> Layout.Box -> (Layout.Box, Layout.Box)
vBoxSplitRel :: Float -> Box -> (Box, Box)
vBoxSplitRel Float
alpha Box
parent =
  case forall (t :: * -> *). Traversable t => t Float -> Box -> t Box
vBoxShares @[] [Float
alpha, Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha] Box
parent of
    [Box
top, Box
bottom] ->
      (Box
top, Box
bottom)
    [Box]
_ ->
      [Char] -> (Box, Box)
forall a. HasCallStack => [Char] -> a
error [Char]
"requesting a pair"

{-# INLINEABLE placeBox #-}
placeBox :: Vec2 -> Vec2 -> Layout.Box -> Layout.Box
placeBox :: Vec2 -> Vec2 -> Box -> Box
placeBox Vec2
alpha2 Vec2
size Box
parent =
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
alpha2 \Float
ax Float
ay ->
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
h ->
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
Layout.boxSize Box
parent) \Float
pw Float
ph ->
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
Layout.boxPosition Box
parent) \Float
px Float
py ->
    let
      x :: Float
x = Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
left Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
      y :: Float
y = Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
bottom Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5

      (Float
left, Float
right) = Float -> Float -> Float -> (Float, Float)
forall b. Num b => b -> b -> b -> (b, b)
place Float
ax Float
w Float
pw
      (Float
top, Float
bottom) = Float -> Float -> Float -> (Float, Float)
forall b. Num b => b -> b -> b -> (b, b)
place Float
ay Float
h Float
ph
    in
      Box :: Vec2 -> Vec2 -> Box
Layout.Box
        { $sel:boxPosition:Box :: Vec2
boxPosition = Float -> Float -> Vec2
vec2 Float
x Float
y
        , $sel:boxSize:Box :: Vec2
boxSize     = Vec2
size
        }

{-# INLINE place #-}
place :: Num b => b -> b -> b -> (b, b)
place :: forall b. Num b => b -> b -> b -> (b, b)
place b
alpha b
size b
target =
  ( b
leftovers b -> b -> b
forall a. Num a => a -> a -> a
* b
alpha
  , b
leftovers b -> b -> b
forall a. Num a => a -> a -> a
* (b
1 b -> b -> b
forall a. Num a => a -> a -> a
- b
alpha)
  )
  where
    leftovers :: b
leftovers = b
target b -> b -> b
forall a. Num a => a -> a -> a
- b
size

{-# INLINE midpoints #-}
midpoints :: (Functor f, Fractional a) => f (a, a) -> f a
midpoints :: forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f (a, a) -> f a
midpoints =
  ((a, a) -> a) -> f (a, a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(a
begin, a
end) ->
    a
begin a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
+ a
end a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5

{-# INLINE ranges #-}
ranges :: (Traversable t, Num a) => t a -> (a, t (a, a))
ranges :: forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges = (a -> a -> (a, (a, a))) -> a -> t a -> (a, t (a, a))
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL a -> a -> (a, (a, a))
forall {b}. Num b => b -> b -> (b, (b, b))
f a
0
  where
    f :: b -> b -> (b, (b, b))
f !b
begin b
size =
      let
        !end :: b
end = b
begin b -> b -> b
forall a. Num a => a -> a -> a
+ b
size
      in
        ( b
end
        , (b
begin, b
end)
        )