Linear.hs

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 items parent = fmap mkBox ranges'
  where
    mkBox (left, right) = Layout.Box
      { boxPosition =
          Layout.boxPosition parent +
          vec2 (midpoint * scale - parentWidth * 0.5) 0
      , boxSize =
          vec2 (size * scale) parentHeight
      }
      where
        size = right - left
        midpoint = right * 0.5 + left * 0.5

    (final, ranges') = ranges items
    scale = parentWidth / final
    WithVec2 parentWidth parentHeight = Layout.boxSize parent

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

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

    (final, ranges') = ranges items
    scale = parentHeight / final
    WithVec2 parentWidth parentHeight = Layout.boxSize parent

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

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

      (left, right) = place ax w pw
      (top, bottom) = place ay h ph
    in
      Layout.Box
        { boxPosition = vec2 x y
        , boxSize     = size
        }

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

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

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