-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Chiphunk/Low/BB.chs" #-}
-- | Description: Utilities for working with bounding box.
-- Module provides utilities for working with bounding box.
module Chiphunk.Low.BB
  ( BB (..)
  , bbNew
  , bbNewForExtents
  , bbNewForCircle
  , bbIntersects
  , bbContainsBB
  , bbContainsVect
  , bbMerge
  , bbExpand
  , bbCenter
  , bbArea
  , bbMergedArea
  , bbSegmentQuery
  , bbIntersectsSegment
  , bbClampVect
  , bbWrapVect
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import Data.Fixed
import Foreign

import Chiphunk.Low.Math

import Chiphunk.Low.Types
{-# LINE 27 "src/Chiphunk/Low/BB.chs" #-}





-- | Convenience constructor for 'BB' structs.
bbNew :: Double -> Double -> Double -> Double -> BB
bbNew :: Double -> Double -> Double -> Double -> BB
bbNew = Double -> Double -> Double -> Double -> BB
BB

-- | Convenience constructor for making a 'BB' fitting with a center point and half width and height.
bbNewForExtents
  :: Vect   -- ^ Center point
  -> Double -- ^ Half width
  -> Double -- ^ Half height
  -> BB
bbNewForExtents :: Vect -> Double -> Double -> BB
bbNewForExtents (Vect Double
x Double
y) Double
hw Double
hh = Double -> Double -> Double -> Double -> BB
BB (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hw) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hh) (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hw) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hh)

-- | Convenience constructor for making a 'BB' fitting a circle at position @p@ with radius @r@.
bbNewForCircle
  :: Vect   -- ^ p
  -> Double -- ^ r
  -> BB
bbNewForCircle :: Vect -> Double -> BB
bbNewForCircle Vect
v Double
r = Vect -> Double -> Double -> BB
bbNewForExtents Vect
v Double
r Double
r

-- | Returns true if the bounding boxes intersect.
bbIntersects :: BB -> BB -> Bool
BB Double
l1 Double
b1 Double
r1 Double
t1 bbIntersects :: BB -> BB -> Bool
`bbIntersects` BB Double
l2 Double
b2 Double
r2 Double
t2 = Double
r1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
l1 Bool -> Bool -> Bool
&& Double
r2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
l2 Bool -> Bool -> Bool
&& Double
t1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
b1 Bool -> Bool -> Bool
&& Double
t2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
b2

-- | Returns true if @bb@ completely contains @other@.
bbContainsBB
  :: BB   -- ^ bb
  -> BB   -- ^ other
  -> Bool
BB Double
l1 Double
b1 Double
r1 Double
t1 bbContainsBB :: BB -> BB -> Bool
`bbContainsBB` BB Double
l2 Double
b2 Double
r2 Double
t2 = Double
l1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
l2 Bool -> Bool -> Bool
&& Double
r1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
r2 Bool -> Bool -> Bool
&& Double
t1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
t2 Bool -> Bool -> Bool
&& Double
b1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
b2

-- | Returns true if @bb@ contains @v@.
bbContainsVect
  :: BB   -- ^ bb
  -> Vect -- ^ v
  -> Bool
BB Double
l Double
b Double
r Double
t bbContainsVect :: BB -> Vect -> Bool
`bbContainsVect` Vect Double
x Double
y = Double
l Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
x Bool -> Bool -> Bool
&& Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
x Bool -> Bool -> Bool
&& Double
b Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
y Bool -> Bool -> Bool
&& Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
y

-- | Return the minimal bounding box that contains both @a@ and @b@.
bbMerge
  :: BB -- ^ a
  -> BB -- ^ b
  -> BB
BB Double
l1 Double
b1 Double
r1 Double
t1 bbMerge :: BB -> BB -> BB
`bbMerge` BB Double
l2 Double
b2 Double
r2 Double
t2 = Double -> Double -> Double -> Double -> BB
BB (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
l1 Double
l2) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
b1 Double
b2) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
r1 Double
r2) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
t1 Double
t2)

-- | Return the minimal bounding box that contains both @bb@ and @v@.
bbExpand
  :: BB   -- ^ bb
  -> Vect -- ^ v
  -> BB
BB Double
l Double
b Double
r Double
t bbExpand :: BB -> Vect -> BB
`bbExpand` Vect Double
x Double
y = Double -> Double -> Double -> Double -> BB
BB (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
l Double
x) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
b Double
y) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
r Double
x) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
t Double
y)

-- | Return the center of @bb@.
bbCenter
  :: BB   -- ^ bb
  -> Vect
bbCenter :: BB -> Vect
bbCenter (BB Double
l Double
b Double
r Double
t) = Double -> Double -> Vect
Vect ((Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) ((Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)

-- | Return the area of @bb@.
bbArea
  :: BB     -- ^ bb
  -> Double
bbArea :: BB -> Double
bbArea (BB Double
l Double
b Double
r Double
t) = (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
l) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b)

-- | Merges @a@ and @b@ then returns the area of the merged bounding box.
bbMergedArea
  :: BB     -- ^ a
  -> BB     -- ^ b
  -> Double
BB Double
l1 Double
b1 Double
r1 Double
t1 bbMergedArea :: BB -> BB -> Double
`bbMergedArea` BB Double
l2 Double
b2 Double
r2 Double
t2 = (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
r1 Double
r2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
l1 Double
l2) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
t1 Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
b1 Double
b2)

-- | Returns the fraction along the segment query the 'BB' is hit. Returns INFINITY if it doesn’t hit.
bbSegmentQuery :: (BB) -- ^ Box
 -> (Vect) -- ^ One segment end
 -> (Vect) -- ^ Other segment end
 -> (Double)
bbSegmentQuery :: BB -> Vect -> Vect -> Double
bbSegmentQuery BB
a1 Vect
a2 Vect
a3 =
  IO Double -> Double
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$
  BB -> (Ptr BB -> IO Double) -> IO Double
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with BB
a1 ((Ptr BB -> IO Double) -> IO Double)
-> (Ptr BB -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr BB
a1' -> 
  Vect -> (Ptr Vect -> IO Double) -> IO Double
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vect
a2 ((Ptr Vect -> IO Double) -> IO Double)
-> (Ptr Vect -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Vect
a2' -> 
  Vect -> (Ptr Vect -> IO Double) -> IO Double
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vect
a3 ((Ptr Vect -> IO Double) -> IO Double)
-> (Ptr Vect -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Vect
a3' -> 
  Ptr BB -> Ptr Vect -> Ptr Vect -> IO CDouble
bbSegmentQuery'_ Ptr BB
a1' Ptr Vect
a2' Ptr Vect
a3' IO CDouble -> (CDouble -> IO Double) -> IO Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CDouble
res ->
  let {res' :: Double
res' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
res} in
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
res')

{-# LINE 107 "src/Chiphunk/Low/BB.chs" #-}


-- | Returns true if the segment defined by endpoints @a@ and @b@ intersect @bb@.
bbIntersectsSegment :: (BB) -- ^ bb
 -> (Vect) -- ^ a
 -> (Vect) -- ^ b
 -> (Bool)
bbIntersectsSegment :: BB -> Vect -> Vect -> Bool
bbIntersectsSegment BB
a1 Vect
a2 Vect
a3 =
  IO Bool -> Bool
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  BB -> (Ptr BB -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with BB
a1 ((Ptr BB -> IO Bool) -> IO Bool) -> (Ptr BB -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr BB
a1' -> 
  Vect -> (Ptr Vect -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vect
a2 ((Ptr Vect -> IO Bool) -> IO Bool)
-> (Ptr Vect -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Vect
a2' -> 
  Vect -> (Ptr Vect -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vect
a3 ((Ptr Vect -> IO Bool) -> IO Bool)
-> (Ptr Vect -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Vect
a3' -> 
  Ptr BB -> Ptr Vect -> Ptr Vect -> IO CUChar
bbIntersectsSegment'_ Ptr BB
a1' Ptr Vect
a2' Ptr Vect
a3' IO CUChar -> (CUChar -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CUChar
res ->
  let {res' :: Bool
res' = CUChar -> Bool
forall a. (Eq a, Num a) => a -> Bool
C2HSImp.toBool CUChar
res} in
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 114 "src/Chiphunk/Low/BB.chs" #-}


-- | Returns a copy of @v@ clamped to the bounding box @bb@.
bbClampVect
  :: BB   -- ^ bb
  -> Vect -- ^ v
  -> Vect
BB l b r t `bbClampVect` Vect x y = Vect (fClamp x l r) (fClamp y b t)

-- | Returns a copy of @v@ wrapped to the bounding box @bb@.
bbWrapVect
  :: BB   -- ^ bb
  -> Vect -- ^ v
  -> Vect
BB Double
l Double
b Double
r Double
t bbWrapVect :: BB -> Vect -> Vect
`bbWrapVect` Vect Double
x Double
y = Double -> Double -> Vect
Vect (Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
l) Double -> Double -> Double
forall a. Real a => a -> a -> a
`mod'` Double -> Double
forall a. Num a => a -> a
abs (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
l))) (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ((Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b) Double -> Double -> Double
forall a. Real a => a -> a -> a
`mod'` Double -> Double
forall a. Num a => a -> a
abs (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b)))

foreign import ccall unsafe "Chiphunk/Low/BB.chs.h __c2hs_wrapped__w_cpBBSegmentQuery"
  bbSegmentQuery'_ :: ((BBPtr) -> ((VectPtr) -> ((VectPtr) -> (IO C2HSImp.CDouble))))

foreign import ccall unsafe "Chiphunk/Low/BB.chs.h __c2hs_wrapped__w_cpBBIntersectsSegment"
  bbIntersectsSegment'_ :: ((BBPtr) -> ((VectPtr) -> ((VectPtr) -> (IO C2HSImp.CUChar))))