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 :: Either Float Float -> Box -> (Box, Box)
horizontal = \case
  Left Float
width ->
    if Float
width Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 then
      Float -> Box -> (Box, Box)
cutLeft Float
width
    else
      Float -> Box -> (Box, Box)
cutRight (-Float
width)
  Right Float
origin ->
    if Float
origin Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 then
      Float -> Box -> (Box, Box)
splitLeft Float
origin
    else
      Float -> Box -> (Box, Box)
splitRight (-Float
origin)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{-# INLINEABLE placeSize #-}
placeSize :: Alignment -> Vec2 -> Box -> Box
placeSize :: Alignment -> Vec2 -> Box -> Box
placeSize (Alignment Vec2
align) Vec2
size Box
parent =
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
align \Float
ah Float
av ->
    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
parent.size \Float
pw Float
ph ->
        let
          (Float
leftoversL, Float
leftoversR) = Float -> Float -> Float -> (Float, Float)
Alignment.placeSize1d Float
ah Float
w Float
pw
          (Float
leftoversT, Float
leftoversB) = Float -> Float -> Float -> (Float, Float)
Alignment.placeSize1d Float
av Float
h Float
ph
        in
          TRBL -> Box -> Box
Box.addPadding
            (Vec4 -> TRBL
TRBL (Vec4 -> TRBL) -> Vec4 -> TRBL
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Vec4
vec4 Float
leftoversT Float
leftoversR Float
leftoversB Float
leftoversL)
            Box
parent

{-# INLINEABLE placeAspect #-}
placeAspect :: Alignment -> Vec2 -> Box -> Box
placeAspect :: Alignment -> Vec2 -> Box -> Box
placeAspect Alignment
align Vec2
aspect Box
parent =
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
aspect \Float
aw Float
ah ->
    Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.size \Float
pw Float
ph ->
      let
        scale :: Float
scale =
          if Float
pw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ph Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
aw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ah then
            Float
ph Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ah
          else
            Float
pw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
aw
      in
        Alignment -> Vec2 -> Box -> Box
placeSize Alignment
align (Vec2
aspect Vec2 -> Float -> Vec2
forall v a. VectorSpace v a => v -> a -> v
^* Float
scale) Box
parent