module Geomancy.Layout.Box where

import Prelude hiding (or)
import Geomancy

import Control.Monad (when)
import Foreign qualified
import Geomancy.Mat4 qualified as Mat4
import GHC.Generics (Generic)
import Graphics.Gl.Block qualified as Block

{- | 2D rectangle with its origin at the center.

Size transformations don't affect its position and vice versa.

@
┏━━━━━┓
┃     ┃
┃  *  ┃
┃     ┃
┗━━━━━┛
@
-}
data Box = Box
  { Box -> Vec2
position :: Vec2
  , Box -> Vec2
size     :: Vec2
  }
  deriving stock (Box -> Box -> Bool
(Box -> Box -> Bool) -> (Box -> Box -> Bool) -> Eq Box
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Box -> Box -> Bool
== :: Box -> Box -> Bool
$c/= :: Box -> Box -> Bool
/= :: Box -> Box -> Bool
Eq, Eq Box
Eq Box =>
(Box -> Box -> Ordering)
-> (Box -> Box -> Bool)
-> (Box -> Box -> Bool)
-> (Box -> Box -> Bool)
-> (Box -> Box -> Bool)
-> (Box -> Box -> Box)
-> (Box -> Box -> Box)
-> Ord Box
Box -> Box -> Bool
Box -> Box -> Ordering
Box -> Box -> Box
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Box -> Box -> Ordering
compare :: Box -> Box -> Ordering
$c< :: Box -> Box -> Bool
< :: Box -> Box -> Bool
$c<= :: Box -> Box -> Bool
<= :: Box -> Box -> Bool
$c> :: Box -> Box -> Bool
> :: Box -> Box -> Bool
$c>= :: Box -> Box -> Bool
>= :: Box -> Box -> Bool
$cmax :: Box -> Box -> Box
max :: Box -> Box -> Box
$cmin :: Box -> Box -> Box
min :: Box -> Box -> Box
Ord, Int -> Box -> ShowS
[Box] -> ShowS
Box -> String
(Int -> Box -> ShowS)
-> (Box -> String) -> ([Box] -> ShowS) -> Show Box
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Box -> ShowS
showsPrec :: Int -> Box -> ShowS
$cshow :: Box -> String
show :: Box -> String
$cshowList :: [Box] -> ShowS
showList :: [Box] -> ShowS
Show, (forall x. Box -> Rep Box x)
-> (forall x. Rep Box x -> Box) -> Generic Box
forall x. Rep Box x -> Box
forall x. Box -> Rep Box x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Box -> Rep Box x
from :: forall x. Box -> Rep Box x
$cto :: forall x. Rep Box x -> Box
to :: forall x. Rep Box x -> Box
Generic)
  deriving anyclass (forall (proxy :: * -> *). proxy Box -> Int)
-> (forall (proxy :: * -> *). proxy Box -> Int)
-> (forall (proxy :: * -> *). proxy Box -> Bool)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a Box -> m Box)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a Box -> Box -> m ())
-> (forall (proxy :: * -> *). proxy Box -> Int)
-> (forall (proxy :: * -> *). proxy Box -> Int)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a Box -> m Box)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a Box -> Box -> m ())
-> (forall (proxy :: * -> *). proxy Box -> Int)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a Box -> m Box)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a Box -> Box -> m ())
-> Block Box
forall b.
(forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Bool)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> Block b
forall (proxy :: * -> *). proxy Box -> Bool
forall (proxy :: * -> *). proxy Box -> Int
forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a Box -> m Box
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Box -> Box -> m ()
$calignment140 :: forall (proxy :: * -> *). proxy Box -> Int
alignment140 :: forall (proxy :: * -> *). proxy Box -> Int
$csizeOf140 :: forall (proxy :: * -> *). proxy Box -> Int
sizeOf140 :: forall (proxy :: * -> *). proxy Box -> Int
$cisStruct :: forall (proxy :: * -> *). proxy Box -> Bool
isStruct :: forall (proxy :: * -> *). proxy Box -> Bool
$cread140 :: forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a Box -> m Box
read140 :: forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a Box -> m Box
$cwrite140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Box -> Box -> m ()
write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Box -> Box -> m ()
$calignment430 :: forall (proxy :: * -> *). proxy Box -> Int
alignment430 :: forall (proxy :: * -> *). proxy Box -> Int
$csizeOf430 :: forall (proxy :: * -> *). proxy Box -> Int
sizeOf430 :: forall (proxy :: * -> *). proxy Box -> Int
$cread430 :: forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a Box -> m Box
read430 :: forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a Box -> m Box
$cwrite430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Box -> Box -> m ()
write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Box -> Box -> m ()
$csizeOfPacked :: forall (proxy :: * -> *). proxy Box -> Int
sizeOfPacked :: forall (proxy :: * -> *). proxy Box -> Int
$creadPacked :: forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a Box -> m Box
readPacked :: forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a Box -> m Box
$cwritePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Box -> Box -> m ()
writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Box -> Box -> m ()
Block.Block
  deriving Ptr Box -> IO Box
Ptr Box -> Int -> IO Box
Ptr Box -> Int -> Box -> IO ()
Ptr Box -> Box -> IO ()
Box -> Int
(Box -> Int)
-> (Box -> Int)
-> (Ptr Box -> Int -> IO Box)
-> (Ptr Box -> Int -> Box -> IO ())
-> (forall b. Ptr b -> Int -> IO Box)
-> (forall b. Ptr b -> Int -> Box -> IO ())
-> (Ptr Box -> IO Box)
-> (Ptr Box -> Box -> IO ())
-> Storable Box
forall b. Ptr b -> Int -> IO Box
forall b. Ptr b -> Int -> Box -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Box -> Int
sizeOf :: Box -> Int
$calignment :: Box -> Int
alignment :: Box -> Int
$cpeekElemOff :: Ptr Box -> Int -> IO Box
peekElemOff :: Ptr Box -> Int -> IO Box
$cpokeElemOff :: Ptr Box -> Int -> Box -> IO ()
pokeElemOff :: Ptr Box -> Int -> Box -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Box
peekByteOff :: forall b. Ptr b -> Int -> IO Box
$cpokeByteOff :: forall b. Ptr b -> Int -> Box -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Box -> IO ()
$cpeek :: Ptr Box -> IO Box
peek :: Ptr Box -> IO Box
$cpoke :: Ptr Box -> Box -> IO ()
poke :: Ptr Box -> Box -> IO ()
Foreign.Storable via (Block.Packed Box)

width :: Box -> Float
width :: Box -> Float
width Box{Vec2
size :: Box -> Vec2
size :: Vec2
size} = Vec2 -> (Float -> Float -> Float) -> Float
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
_ -> Float
w

height :: Box -> Float
height :: Box -> Float
height Box{Vec2
size :: Box -> Vec2
size :: Vec2
size} = Vec2 -> (Float -> Float -> Float) -> Float
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
_ Float
h -> Float
h

-- | Place a 'Box' with given dimensions at @(0,0)@.
{-# INLINE box_ #-}
box_ :: Vec2 -> Box
box_ :: Vec2 -> Box
box_ = Vec2 -> Vec2 -> Box
Box Vec2
0

instance Semigroup Box where
  {-# INLINE (<>) #-}
  <> :: Box -> Box -> Box
(<>) = Box -> Box -> Box
union

-- XXX: Box is not a Monoid because mempty = box_ 0 would add (0,0) to every box.

-- | Check if one of the dimensions is negative.
{-# INLINE degenerate #-}
degenerate :: Box -> Bool
degenerate :: Box -> Bool
degenerate Box
box =
  Vec2 -> (Float -> Float -> Bool) -> Bool
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
box.size \Float
w Float
h ->
    Float
w Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 Bool -> Bool -> Bool
||
    Float
h Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0

-- | Move the 'Box' by the given vector.
{-# INLINE move #-}
move :: Vec2 -> Box -> Box
move :: Vec2 -> Box -> Box
move Vec2
delta Box
box = Box
box
  { position =
      box.position + delta
  }

-- | Adjust 'Box' size by a given amount (absolute).
{-# INLINE resize #-}
resize :: Vec2 -> Box -> Box
resize :: Vec2 -> Box -> Box
resize Vec2
delta Box
box = Box
box
  { size =
      box.size + delta
  }

-- | Adjust 'Box' size by a given amount (relative).
{-# INLINE rescale #-}
rescale :: Vec2 -> Box -> Box
rescale :: Vec2 -> Box -> Box
rescale Vec2
delta Box
box = Box
box
  { size =
      box.size * delta
  }

-- * Edge representation

-- | Packed top- right- bottom- left- edge values.
newtype TRBL = TRBL Vec4
  deriving stock (TRBL -> TRBL -> Bool
(TRBL -> TRBL -> Bool) -> (TRBL -> TRBL -> Bool) -> Eq TRBL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TRBL -> TRBL -> Bool
== :: TRBL -> TRBL -> Bool
$c/= :: TRBL -> TRBL -> Bool
/= :: TRBL -> TRBL -> Bool
Eq, Eq TRBL
Eq TRBL =>
(TRBL -> TRBL -> Ordering)
-> (TRBL -> TRBL -> Bool)
-> (TRBL -> TRBL -> Bool)
-> (TRBL -> TRBL -> Bool)
-> (TRBL -> TRBL -> Bool)
-> (TRBL -> TRBL -> TRBL)
-> (TRBL -> TRBL -> TRBL)
-> Ord TRBL
TRBL -> TRBL -> Bool
TRBL -> TRBL -> Ordering
TRBL -> TRBL -> TRBL
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TRBL -> TRBL -> Ordering
compare :: TRBL -> TRBL -> Ordering
$c< :: TRBL -> TRBL -> Bool
< :: TRBL -> TRBL -> Bool
$c<= :: TRBL -> TRBL -> Bool
<= :: TRBL -> TRBL -> Bool
$c> :: TRBL -> TRBL -> Bool
> :: TRBL -> TRBL -> Bool
$c>= :: TRBL -> TRBL -> Bool
>= :: TRBL -> TRBL -> Bool
$cmax :: TRBL -> TRBL -> TRBL
max :: TRBL -> TRBL -> TRBL
$cmin :: TRBL -> TRBL -> TRBL
min :: TRBL -> TRBL -> TRBL
Ord, Int -> TRBL -> ShowS
[TRBL] -> ShowS
TRBL -> String
(Int -> TRBL -> ShowS)
-> (TRBL -> String) -> ([TRBL] -> ShowS) -> Show TRBL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TRBL -> ShowS
showsPrec :: Int -> TRBL -> ShowS
$cshow :: TRBL -> String
show :: TRBL -> String
$cshowList :: [TRBL] -> ShowS
showList :: [TRBL] -> ShowS
Show, (forall x. TRBL -> Rep TRBL x)
-> (forall x. Rep TRBL x -> TRBL) -> Generic TRBL
forall x. Rep TRBL x -> TRBL
forall x. TRBL -> Rep TRBL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TRBL -> Rep TRBL x
from :: forall x. TRBL -> Rep TRBL x
$cto :: forall x. Rep TRBL x -> TRBL
to :: forall x. Rep TRBL x -> TRBL
Generic)

instance Semigroup TRBL where
  {-# INLINE (<>) #-}
  TRBL Vec4
a <> :: TRBL -> TRBL -> TRBL
<> TRBL Vec4
b =
    Vec4 -> (Float -> Float -> Float -> Float -> TRBL) -> TRBL
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
a \Float
at Float
ar Float
ab Float
al ->
      Vec4 -> (Float -> Float -> Float -> Float -> TRBL) -> TRBL
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
b \Float
bt Float
br Float
bb Float
bl ->
        Vec4 -> TRBL
TRBL (Vec4 -> TRBL) -> Vec4 -> TRBL
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Vec4
vec4 (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
at Float
bt) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
ar Float
br) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
ab Float
bb) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
al Float
bl)

type WithTRBL r = Float -> Float -> Float -> Float -> r

{-# INLINE fromTRBL #-}
fromTRBL :: WithTRBL Box
fromTRBL :: WithTRBL Box
fromTRBL Float
t Float
r Float
b Float
l =
  Box
    { position :: Vec2
position =
        -- XXX: recover midpoint
        Float -> Float -> Vec2
vec2
          (Float
l Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5)
          (Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5)
    , size :: Vec2
size =
        -- XXX: recover size
        Float -> Float -> Vec2
vec2 (Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
l) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
t)
    }

{-# INLINE toTRBL #-}
toTRBL :: Box -> TRBL
toTRBL :: Box -> TRBL
toTRBL Box
box = Vec4 -> TRBL
TRBL (Vec4 -> TRBL) -> Vec4 -> TRBL
forall a b. (a -> b) -> a -> b
$ Box -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Box -> WithTRBL r -> r
withTRBL Box
box Float -> Float -> Float -> Float -> Vec4
vec4

{-# INLINE withTRBL #-}
withTRBL :: Box -> WithTRBL r -> r
withTRBL :: forall r. Box -> WithTRBL r -> r
withTRBL Box{Vec2
position :: Box -> Vec2
size :: Box -> Vec2
position :: Vec2
size :: Vec2
..} WithTRBL r
f =
  Vec2 -> (Float -> Float -> r) -> r
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
position \Float
x Float
y ->
    Vec2 -> (Float -> Float -> r) -> r
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
h ->
      let
        t :: Float
t = Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
        r :: Float
r = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
        b :: Float
b = Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
        l :: Float
l = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
      in
        WithTRBL r
f Float
t Float
r Float
b Float
l

-- | Construct a smaller Box by adding non-uniform padding.
{-# INLINE addPadding #-}
addPadding :: TRBL -> Box -> Box
addPadding :: TRBL -> Box -> Box
addPadding (TRBL Vec4
padding) Box
box =
  Vec4 -> WithTRBL Box -> Box
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
padding \Float
pt Float
pr Float
pb Float
pl ->
    Box -> WithTRBL Box -> Box
forall r. Box -> WithTRBL r -> r
withTRBL Box
box \Float
t Float
r Float
b Float
l ->
      WithTRBL Box
fromTRBL (Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
pt) (Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
pr) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
pb) (Float
l Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
pl)

-- | Construct a smaller Box by adding non-uniform padding as a fraction of 'Box' size.
{-# INLINE addPaddingRel #-}
addPaddingRel :: TRBL -> Box -> Box
addPaddingRel :: TRBL -> Box -> Box
addPaddingRel (TRBL Vec4
padding) Box
box =
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
box.size \Float
w Float
h ->
    TRBL -> Box -> Box
addPadding (Vec4 -> TRBL
TRBL (Vec4 -> TRBL) -> Vec4 -> TRBL
forall a b. (a -> b) -> a -> b
$ Vec4
padding Vec4 -> Vec4 -> Vec4
forall a. Num a => a -> a -> a
* Float -> Float -> Float -> Float -> Vec4
vec4 Float
h Float
w Float
h Float
w) Box
box

-- | Construct a larger Box by adding non-uniform margins.
{-# INLINE addMargins #-}
addMargins :: TRBL -> Box -> Box
addMargins :: TRBL -> Box -> Box
addMargins (TRBL Vec4
margins) Box
box =
  Vec4 -> WithTRBL Box -> Box
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
margins \Float
mt Float
mr Float
mb Float
ml ->
    Box -> WithTRBL Box -> Box
forall r. Box -> WithTRBL r -> r
withTRBL Box
box \Float
t Float
r Float
b Float
l ->
      WithTRBL Box
fromTRBL (Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
mt) (Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
mr) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
mb) (Float
l Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ml)

-- | Construct a larger Box by adding non-uniform margins as a fraction of 'Box' size.
{-# INLINE addMarginsRel #-}
addMarginsRel :: TRBL -> Box -> Box
addMarginsRel :: TRBL -> Box -> Box
addMarginsRel (TRBL Vec4
margins) Box
box =
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
box.size \Float
w Float
h ->
    TRBL -> Box -> Box
addMargins (Vec4 -> TRBL
TRBL (Vec4 -> TRBL) -> Vec4 -> TRBL
forall a b. (a -> b) -> a -> b
$ Vec4
margins Vec4 -> Vec4 -> Vec4
forall a. Num a => a -> a -> a
* Float -> Float -> Float -> Float -> Vec4
vec4 Float
h Float
w Float
h Float
w) Box
box

-- * AABB representation

-- | Bounding box from 2 points, automatically sorted.
{-# INLINE fromCorners #-}
fromCorners :: Vec2 -> Vec2 -> Box
fromCorners :: Vec2 -> Vec2 -> Box
fromCorners Vec2
a Vec2
b =
  Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
a \Float
ax Float
ay ->
    Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
b \Float
bx Float
by ->
      WithTRBL Box
fromTRBL (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
ay Float
by) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
ax Float
bx) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
ay Float
by) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
ax Float
bx)

-- | 2-point AABB.
{-# INLINE toCorners #-}
toCorners :: Box -> (Vec2, Vec2)
toCorners :: Box -> (Vec2, Vec2)
toCorners Box
box = Box -> (Vec2 -> Vec2 -> (Vec2, Vec2)) -> (Vec2, Vec2)
forall r. Box -> (Vec2 -> Vec2 -> r) -> r
withCorners Box
box (,)

{-# INLINE withCorners #-}
withCorners :: Box -> (Vec2 -> Vec2 -> r) -> r
withCorners :: forall r. Box -> (Vec2 -> Vec2 -> r) -> r
withCorners Box
box Vec2 -> Vec2 -> r
f =
  Box -> WithTRBL r -> r
forall r. Box -> WithTRBL r -> r
withTRBL Box
box \Float
t Float
r Float
b Float
l ->
    Vec2 -> Vec2 -> r
f (Float -> Float -> Vec2
vec2 Float
l Float
t) (Float -> Float -> Vec2
vec2 Float
r Float
b)

-- * Point-box interaction

-- | Project a point into the 'Box' space.
{-# INLINE projectInto #-}
projectInto :: Vec2 -> Box -> Vec2
projectInto :: Vec2 -> Box -> Vec2
projectInto Vec2
point Box
box = Vec2
point Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
- Box
box.position

-- | Test if a point is within the 'Box' bounds.
{-# INLINE inside #-}
inside :: Vec2 -> Box -> Bool
inside :: Vec2 -> Box -> Bool
inside Vec2
point Box
box =
  Vec2 -> (Float -> Float -> Bool) -> Bool
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Vec2
point Vec2 -> Box -> Vec2
`projectInto` Box
box) \Float
px Float
py ->
    Vec2 -> (Float -> Float -> Bool) -> Bool
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box
box.size Vec2 -> Vec2 -> Vec2
forall a. Fractional a => a -> a -> a
/ Vec2
2) \Float
hw Float
hh ->
      Float
px Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> -Float
hw Bool -> Bool -> Bool
&& Float
px Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
hw Bool -> Bool -> Bool
&&
      Float
py Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> -Float
hh Bool -> Bool -> Bool
&& Float
py Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
hh

whenInside :: Applicative m => Vec2 -> Box -> (Vec2 -> m ()) -> m ()
whenInside :: forall (m :: * -> *).
Applicative m =>
Vec2 -> Box -> (Vec2 -> m ()) -> m ()
whenInside Vec2
point Box
box Vec2 -> m ()
action =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Vec2 -> Box -> Bool
inside Vec2
point Box
box) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Vec2 -> m ()
action (Vec2
point Vec2 -> Box -> Vec2
`projectInto` Box
box)

-- * Box-box interaction

-- | Test if a 'Box' can contain a given 'Box'.
{-# INLINE canContain #-}
canContain :: Box -> Box -> Bool
canContain :: Box -> Box -> Bool
canContain Box
outer Box
inner =
  Vec2 -> (Float -> Float -> Bool) -> Bool
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
inner.size \Float
iw Float
ih ->
    Vec2 -> (Float -> Float -> Bool) -> Bool
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
outer.size \Float
ow Float
oh ->
      Float
iw Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
ow Bool -> Bool -> Bool
&&
      Float
ih Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
oh

-- | Test if a 'Box' fully contains a given 'Box'.
{-# INLINE contains #-}
contains :: Box -> Box -> Bool
contains :: Box -> Box -> Bool
contains Box
outer Box
inner =
  Box -> WithTRBL Bool -> Bool
forall r. Box -> WithTRBL r -> r
withTRBL Box
outer \Float
ot Float
or Float
ob Float
ol ->
    Box -> WithTRBL Bool -> Bool
forall r. Box -> WithTRBL r -> r
withTRBL Box
inner \Float
it Float
ir Float
ib Float
il ->
      Float
it Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
ot Bool -> Bool -> Bool
&&
      Float
ir Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
or Bool -> Bool -> Bool
&&
      Float
ib Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
ob Bool -> Bool -> Bool
&&
      Float
il Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
ol

{-# INLINE union #-}
-- | Get a 'Box' that tightly wraps both its elements.
union :: Box -> Box -> Box
union :: Box -> Box -> Box
union Box
a Box
b =
  Box -> WithTRBL Box -> Box
forall r. Box -> WithTRBL r -> r
withTRBL Box
a \Float
at Float
ar Float
ab Float
al ->
    Box -> WithTRBL Box -> Box
forall r. Box -> WithTRBL r -> r
withTRBL Box
b \Float
bt Float
br Float
bb Float
bl ->
      WithTRBL Box
fromTRBL (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
at Float
bt) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
ar Float
br) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
ab Float
bb) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
al Float
bl)

{- | Get an intersection between two boxes, if there is one.

Use faster `intersects` instead if only need a test.
-}
intersection :: Box -> Box -> Maybe Box
intersection :: Box -> Box -> Maybe Box
intersection Box
a Box
b =
  if Box -> Bool
degenerate Box
candidate then
    Maybe Box
forall a. Maybe a
Nothing
  else
    Box -> Maybe Box
forall a. a -> Maybe a
Just Box
candidate
  where
    candidate :: Box
candidate = Box -> Box -> Box
intersectionDirty Box
a Box
b

-- | Get a potentially-degenerate intersection between two boxes.
{-# INLINE intersectionDirty #-}
intersectionDirty :: Box -> Box -> Box
intersectionDirty :: Box -> Box -> Box
intersectionDirty Box
a Box
b =
  Box -> WithTRBL Box -> Box
forall r. Box -> WithTRBL r -> r
withTRBL Box
a \Float
at Float
ar Float
ab Float
al ->
    Box -> WithTRBL Box -> Box
forall r. Box -> WithTRBL r -> r
withTRBL Box
b \Float
bt Float
br Float
bb Float
bl ->
      WithTRBL Box
fromTRBL (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
at Float
bt) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
ar Float
br) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
ab Float
bb) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
al Float
bl)

{- | Box-box intersection test.

Any edge contact counts as intersection.
For area contact use 'intersection`, which is a little less efficient.
-}
{-# INLINE intersects #-}
intersects :: Box -> Box -> Bool
intersects :: Box -> Box -> Bool
intersects Box
a Box
b =
  Box -> WithTRBL Bool -> Bool
forall r. Box -> WithTRBL r -> r
withTRBL Box
a \Float
at Float
ar Float
ab Float
al ->
    Box -> WithTRBL Bool -> Bool
forall r. Box -> WithTRBL r -> r
withTRBL Box
b \Float
bt Float
br Float
bb Float
bl ->
      Float
at Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
bb Bool -> Bool -> Bool
&&
      Float
al Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
br Bool -> Bool -> Bool
&&
      Float
bl Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
ar Bool -> Bool -> Bool
&&
      Float
bt Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
ab
-- TODO: SIMD `intersects`

{- | Remaining space when one box is placed inside another.

All positive when the box is fully inside.
Negative edges mean the box is "outside" in that direction.

@
addPadding (leftovers inner outer) inner === outer
addMargins (leftovers inner outer) outer === inner
@
-}
leftovers :: Box -> Box -> TRBL
leftovers :: Box -> Box -> TRBL
leftovers Box
a Box
b =
  Vec4 -> TRBL
TRBL (Vec4 -> TRBL) -> Vec4 -> TRBL
forall a b. (a -> b) -> a -> b
$ Box -> Box -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Box -> Box -> WithTRBL r -> r
withLeftovers Box
a Box
b Float -> Float -> Float -> Float -> Vec4
vec4

withLeftovers :: Box -> Box -> WithTRBL r -> r
withLeftovers :: forall r. Box -> Box -> WithTRBL r -> r
withLeftovers Box
a Box
b WithTRBL r
f =
  Box -> WithTRBL r -> r
forall r. Box -> WithTRBL r -> r
withTRBL Box
a \Float
ta Float
ra Float
ba Float
la ->
    Box -> WithTRBL r -> r
forall r. Box -> WithTRBL r -> r
withTRBL Box
b \Float
tb Float
rb Float
bb Float
lb ->
      WithTRBL r
f
        (Float
tb Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ta)
        (Float
ra Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
rb)
        (Float
ba Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
bb)
        (Float
lb Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
la)

-- * Conversion

-- | Build a transformation matrix to stretch a unit square and place it at depth 0.0.
{-# INLINE mkTransform #-}
mkTransform :: Box -> Transform
mkTransform :: Box -> Transform
mkTransform = Float -> Box -> Transform
mkTransformZ Float
0.0

-- | Build a transformation matrix to stretch a unit square and place it at a given depth.
{-# INLINE mkTransformZ #-}
mkTransformZ :: Float -> Box -> Transform
mkTransformZ :: Float -> Box -> Transform
mkTransformZ Float
z Box{Vec2
position :: Box -> Vec2
size :: Box -> Vec2
position :: Vec2
size :: Vec2
..} =
  Vec2 -> (Float -> Float -> Transform) -> Transform
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
position \Float
x Float
y ->
    Vec2 -> (Float -> Float -> Transform) -> Transform
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
h ->
      Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
Mat4.rowMajor
        Float
w Float
0 Float
0 Float
0
        Float
0 Float
h Float
0 Float
0
        Float
0 Float
0 Float
1 Float
0
        Float
x Float
y Float
z Float
1