geomancy-layout-0.1.1: src/Geomancy/Layout.hs

module Geomancy.Layout where

import Geomancy

import Geomancy.Layout.Alignment (Alignment(..), Origin)
import Geomancy.Layout.Alignment qualified as Alignment
import Geomancy.Layout.Box (Box(..), TRBL(..))
import Geomancy.Layout.Box qualified as Box
-- import Debug.Trace

type Offset = Float

horizontal
  :: Either Offset Origin
  -> Box
  -> (Box, Box)
horizontal = \case
  Left width ->
    if width >= 0 then
      cutLeft width
    else
      cutRight (-width)
  Right origin ->
    if origin >= 0 then
      splitLeft origin
    else
      splitRight (-origin)

vertical
  :: Either Offset Origin
  -> Box
  -> (Box, Box)
vertical = \case
  Left height ->
    if height >= 0 then
      cutTop height
    else
      cutBottom (-height)
  Right origin ->
    if origin >= 0 then
      splitTop origin
    else
      splitBottom (-origin)

cutLeft :: Offset -> Box -> (Box, Box)
cutLeft width parent =
  Box.withTRBL parent \t r b l ->
    let
      edge = l + width
    in
      ( Box.fromTRBL t edge b l
      , Box.fromTRBL t r b edge
      )

cutRight :: Offset -> Box -> (Box, Box)
cutRight width parent =
  Box.withTRBL parent \t r b l ->
    let
      edge = r - width
    in
      ( Box.fromTRBL t edge b l
      , Box.fromTRBL t r b edge
      )

cutTop :: Offset -> Box -> (Box, Box)
cutTop height parent =
  Box.withTRBL parent \t r b l ->
    let
      edge = t + height
    in
      ( Box.fromTRBL t r edge l
      , Box.fromTRBL edge r b l
      )

cutBottom :: Offset -> Box -> (Box, Box)
cutBottom height parent =
  Box.withTRBL parent \t r b l ->
    let
      edge = b - height
    in
      ( Box.fromTRBL t r edge l
      , Box.fromTRBL edge r b l
      )

{-# INLINE splitLeft #-}
splitLeft :: Origin -> Box -> (Box, Box)
splitLeft origin parent =
  withVec2 parent.size \w _h ->
    cutLeft (w * origin) parent

{-# INLINE splitRight #-}
splitRight :: Origin -> Box -> (Box, Box)
splitRight origin parent =
  withVec2 parent.size \w _h ->
    cutRight (w * origin) parent

{-# INLINE splitTop #-}
splitTop :: Origin -> Box -> (Box, Box)
splitTop origin parent =
  withVec2 parent.size \_w h ->
    cutTop (h * origin) parent

{-# INLINE splitBottom #-}
splitBottom :: Origin -> Box -> (Box, Box)
splitBottom origin parent =
  withVec2 parent.size \_w h ->
    cutBottom (h * origin) parent

attachLeft :: Offset -> Box -> Box -> Box
attachLeft offset parent box =
  withVec2 parent.position \px py ->
    withVec2 parent.size \pw _ph ->
      withVec2 box.size \w _h ->
        let
          pleft = px - pw * 0.5
          right = pleft - offset
        in
          box
            { position =
                vec2 (right - w * 0.5) py
            }

attachRight :: Offset -> Box -> Box -> Box
attachRight offset parent box =
  withVec2 parent.position \px py ->
    withVec2 parent.size \pw _ph ->
      withVec2 box.size \w _h ->
        let
          pright = px + pw * 0.5
          left = pright + offset
        in
          box
            { position =
                vec2 (left + w * 0.5) py
            }

alignV :: Origin -> Box -> Box -> Box
alignV origin parent box =
  withVec2 parent.position \_px py ->
    withVec2 parent.size \_pw ph ->
      withVec2 box.position \x _y ->
        withVec2 box.size \_w h ->
          let
            (before, after) = Alignment.placeSize1d origin h ph
            y' = py + before * 0.5 - after * 0.5
          in
            box
              { position =
                  vec2 x y'
              }

attachTop :: Float -> Box -> Box -> Box
attachTop offset parent box =
  withVec2 parent.position \px py ->
    withVec2 parent.size \_pw ph ->
      withVec2 box.size \_w h ->
        let
          ptop = py - ph * 0.5
          bottom = ptop - offset
        in
          box
            { position =
                vec2 px (bottom - h * 0.5)
            }

attachBottom :: Float -> Box -> Box -> Box
attachBottom offset parent box =
  withVec2 parent.position \px py ->
    withVec2 parent.size \_pw ph ->
      withVec2 box.size \_w h ->
        let
          pbottom = py + ph * 0.5
          top = pbottom + offset
        in
          box
            { position =
                vec2 px (top + h * 0.5)
            }

alignH :: Origin -> Box -> Box -> Box
alignH origin parent box =
  withVec2 parent.position \px _py ->
    withVec2 parent.size \pw _ph ->
      withVec2 box.position \_x y ->
        withVec2 box.size \w _h ->
          let
            (before, after) = Alignment.placeSize1d origin w pw
            x' = px + before * 0.5 - after * 0.5
          in
            box
              { position =
                  vec2 x' y
              }

{-# INLINEABLE placeSize #-}
placeSize :: Alignment -> Vec2 -> Box -> Box
placeSize (Alignment align) size parent =
  withVec2 align \ah av ->
    withVec2 size \w h ->
      withVec2 parent.size \pw ph ->
        let
          (leftoversL, leftoversR) = Alignment.placeSize1d ah w pw
          (leftoversT, leftoversB) = Alignment.placeSize1d av h ph
        in
          Box.addPadding
            (TRBL $ vec4 leftoversT leftoversR leftoversB leftoversL)
            parent

{-# INLINEABLE placeAspect #-}
placeAspect :: Alignment -> Vec2 -> Box -> Box
placeAspect align aspect parent =
  withVec2 aspect \aw ah ->
    withVec2 parent.size \pw ph ->
      let
        scale =
          if pw / ph > aw / ah then
            ph / ah
          else
            pw / aw
      in
        placeSize align (aspect ^* scale) parent