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 = 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) = Layout.Box
      { $sel:boxPosition:Box :: Vec2
boxPosition =
          Box -> Vec2
Layout.boxPosition Box
parent forall a. Num a => a -> a -> a
+
          Float -> Float -> Vec2
vec2 (Float
midpoint forall a. Num a => a -> a -> a
* Float
scale forall a. Num a => a -> a -> a
- Float
parentWidth forall a. Num a => a -> a -> a
* Float
0.5) Float
0
      , $sel:boxSize:Box :: Vec2
boxSize =
          Float -> Float -> Vec2
vec2 (Float
size forall a. Num a => a -> a -> a
* Float
scale) Float
parentHeight
      }
      where
        size :: Float
size = Float
right forall a. Num a => a -> a -> a
- Float
left
        midpoint :: Float
midpoint = Float
right forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
+ Float
left forall a. Num a => a -> a -> a
* Float
0.5

    (Float
final, t (Float, Float)
ranges') = forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges t Float
items
    scale :: Float
scale = Float
parentWidth 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 forall a. Num a => a -> a -> a
- Float
alpha] Box
parent of
    [Box
left, Box
right] ->
      (Box
left, Box
right)
    [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 = 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) = Layout.Box
      { $sel:boxPosition:Box :: Vec2
boxPosition =
          Box -> Vec2
Layout.boxPosition Box
parent forall a. Num a => a -> a -> a
+
          Float -> Float -> Vec2
vec2 Float
0 (Float
midpoint forall a. Num a => a -> a -> a
* Float
scale forall a. Num a => a -> a -> a
- Float
parentHeight forall a. Num a => a -> a -> a
* Float
0.5)
      , $sel:boxSize:Box :: Vec2
boxSize =
          Float -> Float -> Vec2
vec2 Float
parentWidth (Float
size forall a. Num a => a -> a -> a
* Float
scale)
      }
      where
        size :: Float
size = Float
bottom forall a. Num a => a -> a -> a
- Float
top
        midpoint :: Float
midpoint = Float
bottom forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
+ Float
top forall a. Num a => a -> a -> a
* Float
0.5

    (Float
final, t (Float, Float)
ranges') = forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges t Float
items
    scale :: Float
scale = Float
parentHeight 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 forall a. Num a => a -> a -> a
- Float
alpha] Box
parent of
    [Box
top, Box
bottom] ->
      (Box
top, Box
bottom)
    [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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
alpha2 \Float
ax Float
ay ->
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
h ->
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
Layout.boxSize Box
parent) \Float
pw Float
ph ->
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
Layout.boxPosition Box
parent) \Float
px Float
py ->
    let
      x :: Float
x = Float
px forall a. Num a => a -> a -> a
+ Float
left forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
- Float
right forall a. Num a => a -> a -> a
* Float
0.5
      y :: Float
y = Float
py forall a. Num a => a -> a -> a
+ Float
top forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
- Float
bottom forall a. Num a => a -> a -> a
* Float
0.5

      (Float
left, Float
right) = forall b. Num b => b -> b -> b -> (b, b)
place Float
ax Float
w Float
pw
      (Float
top, Float
bottom) = forall b. Num b => b -> b -> b -> (b, b)
place Float
ay Float
h Float
ph
    in
      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 forall a. Num a => a -> a -> a
* b
alpha
  , b
leftovers forall a. Num a => a -> a -> a
* (b
1 forall a. Num a => a -> a -> a
- b
alpha)
  )
  where
    leftovers :: b
leftovers = b
target 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 =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(a
begin, a
end) ->
    a
begin forall a. Num a => a -> a -> a
* a
0.5 forall a. Num a => a -> a -> a
+ a
end 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 = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL 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 forall a. Num a => a -> a -> a
+ b
size
      in
        ( b
end
        , (b
begin, b
end)
        )