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

-- | 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

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

-- * Edge representation

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

instance Semigroup TRBL where
  {-# INLINE (<>) #-}
  TRBL Vec4
a <> :: TRBL -> TRBL -> TRBL
<> TRBL Vec4
b =
    forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
a \Float
at Float
ar Float
ab Float
al ->
      forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
b \Float
bt Float
br Float
bb Float
bl ->
        Vec4 -> TRBL
TRBL forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Vec4
vec4 (forall a. Ord a => a -> a -> a
min Float
at Float
bt) (forall a. Ord a => a -> a -> a
min Float
ar Float
br) (forall a. Ord a => a -> a -> a
min Float
ab Float
bb) (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 forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
+ Float
r forall a. Num a => a -> a -> a
* Float
0.5)
          (Float
t forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
+ Float
b forall a. Num a => a -> a -> a
* Float
0.5)
    , size :: Vec2
size =
        -- XXX: recover size
        Float -> Float -> Vec2
vec2 (Float
r forall a. Num a => a -> a -> a
- Float
l) (Float
b forall a. Num a => a -> a -> a
- Float
t)
    }

{-# INLINE toTRBL #-}
toTRBL :: Box -> TRBL
toTRBL :: Box -> TRBL
toTRBL Box
box = Vec4 -> TRBL
TRBL forall a b. (a -> b) -> a -> b
$ 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
size :: Vec2
position :: Vec2
size :: Box -> Vec2
position :: Box -> Vec2
..} WithTRBL r
f =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
position \Float
x Float
y ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
h ->
      let
        t :: Float
t = Float
y forall a. Num a => a -> a -> a
- Float
h forall a. Num a => a -> a -> a
* Float
0.5
        r :: Float
r = Float
x forall a. Num a => a -> a -> a
+ Float
w forall a. Num a => a -> a -> a
* Float
0.5
        b :: Float
b = Float
y forall a. Num a => a -> a -> a
+ Float
h forall a. Num a => a -> a -> a
* Float
0.5
        l :: Float
l = Float
x forall a. Num a => a -> a -> a
- Float
w 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 =
  forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
padding \Float
pt Float
pr Float
pb Float
pl ->
    forall r. Box -> WithTRBL r -> r
withTRBL Box
box \Float
t Float
r Float
b Float
l ->
      WithTRBL Box
fromTRBL (Float
t forall a. Num a => a -> a -> a
+ Float
pt) (Float
r forall a. Num a => a -> a -> a
- Float
pr) (Float
b forall a. Num a => a -> a -> a
- Float
pb) (Float
l 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
box.size \Float
w Float
h ->
    TRBL -> Box -> Box
addPadding (Vec4 -> TRBL
TRBL forall a b. (a -> b) -> a -> b
$ Vec4
padding 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 =
  forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
margins \Float
mt Float
mr Float
mb Float
ml ->
    forall r. Box -> WithTRBL r -> r
withTRBL Box
box \Float
t Float
r Float
b Float
l ->
      WithTRBL Box
fromTRBL (Float
t forall a. Num a => a -> a -> a
- Float
mt) (Float
r forall a. Num a => a -> a -> a
+ Float
mr) (Float
b forall a. Num a => a -> a -> a
+ Float
mb) (Float
l 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
box.size \Float
w Float
h ->
    TRBL -> Box -> Box
addMargins (Vec4 -> TRBL
TRBL forall a b. (a -> b) -> a -> b
$ Vec4
margins 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
a \Float
ax Float
ay ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
b \Float
bx Float
by ->
      WithTRBL Box
fromTRBL (forall a. Ord a => a -> a -> a
min Float
ay Float
by) (forall a. Ord a => a -> a -> a
max Float
ax Float
bx) (forall a. Ord a => a -> a -> a
max Float
ay Float
by) (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 = 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 =
  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 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Vec2
point Vec2 -> Box -> Vec2
`projectInto` Box
box) \Float
px Float
py ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box
box.size forall a. Fractional a => a -> a -> a
/ Vec2
2) \Float
hw Float
hh ->
      Float
px forall a. Ord a => a -> a -> Bool
> -Float
hw Bool -> Bool -> Bool
&& Float
px forall a. Ord a => a -> a -> Bool
< Float
hw Bool -> Bool -> Bool
&&
      Float
py forall a. Ord a => a -> a -> Bool
> -Float
hh Bool -> Bool -> Bool
&& Float
py 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 =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Vec2 -> Box -> Bool
inside Vec2
point Box
box) 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 =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
inner.size \Float
iw Float
ih ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Box
outer.size \Float
ow Float
oh ->
      Float
iw forall a. Ord a => a -> a -> Bool
<= Float
ow Bool -> Bool -> Bool
&&
      Float
ih 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 =
  forall r. Box -> WithTRBL r -> r
withTRBL Box
outer \Float
ot Float
or Float
ob Float
ol ->
    forall r. Box -> WithTRBL r -> r
withTRBL Box
inner \Float
it Float
ir Float
ib Float
il ->
      Float
it forall a. Ord a => a -> a -> Bool
>= Float
ot Bool -> Bool -> Bool
&&
      Float
ir forall a. Ord a => a -> a -> Bool
<= Float
or Bool -> Bool -> Bool
&&
      Float
ib forall a. Ord a => a -> a -> Bool
<= Float
ob Bool -> Bool -> Bool
&&
      Float
il 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 =
  forall r. Box -> WithTRBL r -> r
withTRBL Box
a \Float
at Float
ar Float
ab Float
al ->
    forall r. Box -> WithTRBL r -> r
withTRBL Box
b \Float
bt Float
br Float
bb Float
bl ->
      WithTRBL Box
fromTRBL (forall a. Ord a => a -> a -> a
min Float
at Float
bt) (forall a. Ord a => a -> a -> a
max Float
ar Float
br) (forall a. Ord a => a -> a -> a
max Float
ab Float
bb) (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
    forall a. Maybe a
Nothing
  else
    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 =
  forall r. Box -> WithTRBL r -> r
withTRBL Box
a \Float
at Float
ar Float
ab Float
al ->
    forall r. Box -> WithTRBL r -> r
withTRBL Box
b \Float
bt Float
br Float
bb Float
bl ->
      WithTRBL Box
fromTRBL (forall a. Ord a => a -> a -> a
max Float
at Float
bt) (forall a. Ord a => a -> a -> a
min Float
ar Float
br) (forall a. Ord a => a -> a -> a
min Float
ab Float
bb) (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 =
  forall r. Box -> WithTRBL r -> r
withTRBL Box
a \Float
at Float
ar Float
ab Float
al ->
    forall r. Box -> WithTRBL r -> r
withTRBL Box
b \Float
bt Float
br Float
bb Float
bl ->
      Float
at forall a. Ord a => a -> a -> Bool
<= Float
bb Bool -> Bool -> Bool
&&
      Float
al forall a. Ord a => a -> a -> Bool
<= Float
br Bool -> Bool -> Bool
&&
      Float
bl forall a. Ord a => a -> a -> Bool
<= Float
ar Bool -> Bool -> Bool
&&
      Float
bt 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 forall a b. (a -> b) -> a -> b
$ 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 =
  forall r. Box -> WithTRBL r -> r
withTRBL Box
a \Float
ta Float
ra Float
ba Float
la ->
    forall r. Box -> WithTRBL r -> r
withTRBL Box
b \Float
tb Float
rb Float
bb Float
lb ->
      WithTRBL r
f
        (Float
tb forall a. Num a => a -> a -> a
- Float
ta)
        (Float
ra forall a. Num a => a -> a -> a
- Float
rb)
        (Float
ba forall a. Num a => a -> a -> a
- Float
bb)
        (Float
lb 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
size :: Vec2
position :: Vec2
size :: Box -> Vec2
position :: Box -> Vec2
..} =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
position \Float
x Float
y ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
h ->
      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