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 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 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 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 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 =
  forall r. Box -> WithTRBL r -> r
Box.withTRBL Box
parent \Float
t Float
r Float
b Float
l ->
    let
      edge :: Float
edge = Float
l 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 =
  forall r. Box -> WithTRBL r -> r
Box.withTRBL Box
parent \Float
t Float
r Float
b Float
l ->
    let
      edge :: Float
edge = Float
r 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 =
  forall r. Box -> WithTRBL r -> r
Box.withTRBL Box
parent \Float
t Float
r Float
b Float
l ->
    let
      edge :: Float
edge = Float
t 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 =
  forall r. Box -> WithTRBL r -> r
Box.withTRBL Box
parent \Float
t Float
r Float
b Float
l ->
    let
      edge :: Float
edge = Float
b 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.size \Float
w Float
_h ->
    Float -> Box -> (Box, Box)
cutLeft (Float
w 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.size \Float
w Float
_h ->
    Float -> Box -> (Box, Box)
cutRight (Float
w 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.size \Float
_w Float
h ->
    Float -> Box -> (Box, Box)
cutTop (Float
h 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.size \Float
_w Float
h ->
    Float -> Box -> (Box, Box)
cutBottom (Float
h 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.position \Float
px Float
py ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.size \Float
pw Float
_ph ->
      forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
box.size \Float
w Float
_h ->
        let
          pleft :: Float
pleft = Float
px forall a. Num a => a -> a -> a
- Float
pw forall a. Num a => a -> a -> a
* Float
0.5
          right :: Float
right = Float
pleft forall a. Num a => a -> a -> a
- Float
offset
        in
          Box
box
            { position :: Vec2
position =
                Float -> Float -> Vec2
vec2 (Float
right forall a. Num a => a -> a -> a
- Float
w forall a. Num a => a -> a -> a
* Float
0.5) Float
py
            }

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

alignV :: Origin -> Box -> Box -> Box
alignV :: Float -> Box -> Box -> Box
alignV Float
origin Box
parent Box
box =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.position \Float
_px Float
py ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.size \Float
_pw Float
ph ->
      forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
box.position \Float
x Float
_y ->
        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 forall a. Num a => a -> a -> a
+ Float
before forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
- Float
after forall a. Num a => a -> a -> a
* Float
0.5
          in
            Box
box
              { position :: Vec2
position =
                  Float -> Float -> Vec2
vec2 Float
x Float
y'
              }

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

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

alignH :: Origin -> Box -> Box -> Box
alignH :: Float -> Box -> Box -> Box
alignH Float
origin Box
parent Box
box =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.position \Float
px Float
_py ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
parent.size \Float
pw Float
_ph ->
      forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
box.position \Float
_x Float
y ->
        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 forall a. Num a => a -> a -> a
+ Float
before forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
- Float
after forall a. Num a => a -> a -> a
* Float
0.5
          in
            Box
box
              { position :: Vec2
position =
                  Float -> Float -> Vec2
vec2 Float
x' Float
y
              }

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