module Waterfall.BoundingBox.Oriented
( OrientedBoundingBox
, obbCenter
, obbSideX
, obbSideY
, obbSideZ
, orientedBoundingBox
, obbToSolid
) where

import Linear (V3 (..), normalize, (^*))
import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)
import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)
import Waterfall.Internal.FromOpenCascade (gpXYZToV3)
import Foreign.Ptr (Ptr)
import Waterfall.Solids (volume, box)
import Waterfall.Transforms (translate)
import qualified OpenCascade.Bnd.OBB as OBB
import OpenCascade.Bnd.OBB (OBB)
import OpenCascade.GP.Types (XYZ)
import qualified OpenCascade.GP as GP
import qualified OpenCascade.GP.Ax3 as Ax3
import qualified OpenCascade.GP.Trsf as Trsf
import qualified OpenCascade.BRepBndLib as BRepBndLib
import qualified OpenCascade.BRepBuilderAPI.Transform  as BRepBuilderAPI.Transform
import Data.Acquire (Acquire)
import Control.Monad.IO.Class (liftIO)
import Control.Monad ((<=<))

-- | An OrientedBoundingBox may be a tighter fit for a Shape than an axis aligned bounding box would be
-- 
data OrientedBoundingBox = OrientedBoundingBox { OrientedBoundingBox -> Ptr OBB
rawOBB :: Ptr OBB }

-- | Compute an OrientedBoundingBox for a solid
orientedBoundingBox :: Solid -> Maybe OrientedBoundingBox
orientedBoundingBox :: Solid -> Maybe OrientedBoundingBox
orientedBoundingBox Solid
s = 
    if Solid -> Double
volume Solid
s Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
        then Maybe OrientedBoundingBox
forall a. Maybe a
Nothing 
        else OrientedBoundingBox -> Maybe OrientedBoundingBox
forall a. a -> Maybe a
Just (OrientedBoundingBox -> Maybe OrientedBoundingBox)
-> (Acquire (Ptr OBB) -> OrientedBoundingBox)
-> Acquire (Ptr OBB)
-> Maybe OrientedBoundingBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr OBB -> OrientedBoundingBox
OrientedBoundingBox (Ptr OBB -> OrientedBoundingBox)
-> (Acquire (Ptr OBB) -> Ptr OBB)
-> Acquire (Ptr OBB)
-> OrientedBoundingBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr OBB) -> Ptr OBB
forall a. Acquire a -> a
unsafeFromAcquire (Acquire (Ptr OBB) -> Maybe OrientedBoundingBox)
-> Acquire (Ptr OBB) -> Maybe OrientedBoundingBox
forall a b. (a -> b) -> a -> b
$ do
            Ptr OBB
obb <- Acquire (Ptr OBB)
OBB.new
            Ptr Shape
solid <- Solid -> Acquire (Ptr Shape)
acquireSolid Solid
s
            IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr Shape -> Ptr OBB -> Bool -> Bool -> Bool -> IO ()
BRepBndLib.addOBB Ptr Shape
solid Ptr OBB
obb Bool
True Bool
True Bool
True
            Ptr OBB -> Acquire (Ptr OBB)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OBB
obb

queryOBB :: (Ptr OBB -> Acquire (V3 Double)) -> OrientedBoundingBox -> V3 Double
queryOBB :: (Ptr OBB -> Acquire (V3 Double))
-> OrientedBoundingBox -> V3 Double
queryOBB Ptr OBB -> Acquire (V3 Double)
f = Acquire (V3 Double) -> V3 Double
forall a. Acquire a -> a
unsafeFromAcquire (Acquire (V3 Double) -> V3 Double)
-> (OrientedBoundingBox -> Acquire (V3 Double))
-> OrientedBoundingBox
-> V3 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( Ptr OBB -> Acquire (V3 Double)
f (Ptr OBB -> Acquire (V3 Double))
-> (OrientedBoundingBox -> Acquire (Ptr OBB))
-> OrientedBoundingBox
-> Acquire (V3 Double)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr OBB -> Acquire (Ptr OBB)
forall a. a -> Acquire a
toAcquire (Ptr OBB -> Acquire (Ptr OBB))
-> (OrientedBoundingBox -> Ptr OBB)
-> OrientedBoundingBox
-> Acquire (Ptr OBB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrientedBoundingBox -> Ptr OBB
rawOBB)

-- | The center point of an `OrientedBoundingBox`
obbCenter :: OrientedBoundingBox -> V3 Double
obbCenter :: OrientedBoundingBox -> V3 Double
obbCenter = (Ptr OBB -> Acquire (V3 Double))
-> OrientedBoundingBox -> V3 Double
queryOBB (IO (V3 Double) -> Acquire (V3 Double)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (V3 Double) -> Acquire (V3 Double))
-> (Ptr XYZ -> IO (V3 Double)) -> Ptr XYZ -> Acquire (V3 Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr XYZ -> IO (V3 Double)
gpXYZToV3 (Ptr XYZ -> Acquire (V3 Double))
-> (Ptr OBB -> Acquire (Ptr XYZ)) -> Ptr OBB -> Acquire (V3 Double)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr OBB -> Acquire (Ptr XYZ)
OBB.center)

getSide :: (Ptr OBB -> Acquire (Ptr XYZ)) -> (Ptr OBB -> IO Double) -> OrientedBoundingBox -> V3 Double
getSide :: (Ptr OBB -> Acquire (Ptr XYZ))
-> (Ptr OBB -> IO Double) -> OrientedBoundingBox -> V3 Double
getSide Ptr OBB -> Acquire (Ptr XYZ)
fxyz Ptr OBB -> IO Double
fLength = (Ptr OBB -> Acquire (V3 Double))
-> OrientedBoundingBox -> V3 Double
queryOBB ((Ptr OBB -> Acquire (V3 Double))
 -> OrientedBoundingBox -> V3 Double)
-> (Ptr OBB -> Acquire (V3 Double))
-> OrientedBoundingBox
-> V3 Double
forall a b. (a -> b) -> a -> b
$ \Ptr OBB
obb -> do
    V3 Double
side <- IO (V3 Double) -> Acquire (V3 Double)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (V3 Double) -> Acquire (V3 Double))
-> (Ptr XYZ -> IO (V3 Double)) -> Ptr XYZ -> Acquire (V3 Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr XYZ -> IO (V3 Double)
gpXYZToV3 (Ptr XYZ -> Acquire (V3 Double))
-> Acquire (Ptr XYZ) -> Acquire (V3 Double)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr OBB -> Acquire (Ptr XYZ)
fxyz Ptr OBB
obb
    Double
len <- IO Double -> Acquire Double
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Acquire Double) -> IO Double -> Acquire Double
forall a b. (a -> b) -> a -> b
$ Ptr OBB -> IO Double
fLength Ptr OBB
obb
    V3 Double -> Acquire (V3 Double)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return (V3 Double -> Acquire (V3 Double))
-> V3 Double -> Acquire (V3 Double)
forall a b. (a -> b) -> a -> b
$ V3 Double -> V3 Double
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize V3 Double
side V3 Double -> Double -> V3 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Double
len

-- | The "X" side of the oriented bounding box.
--
-- This is measured from the center to one Face.
-- So the length of this vector is _half_ of the side length of the bounding box.
obbSideX :: OrientedBoundingBox -> V3 Double 
obbSideX :: OrientedBoundingBox -> V3 Double
obbSideX = (Ptr OBB -> Acquire (Ptr XYZ))
-> (Ptr OBB -> IO Double) -> OrientedBoundingBox -> V3 Double
getSide Ptr OBB -> Acquire (Ptr XYZ)
OBB.xDirection Ptr OBB -> IO Double
OBB.xHSize
    
-- | The "Y" side of the oriented bounding box.
--
-- This is measured from the center to one face.
-- So the length of this vector is _half_ of the side length of the bounding box.
obbSideY :: OrientedBoundingBox -> V3 Double 
obbSideY :: OrientedBoundingBox -> V3 Double
obbSideY = (Ptr OBB -> Acquire (Ptr XYZ))
-> (Ptr OBB -> IO Double) -> OrientedBoundingBox -> V3 Double
getSide Ptr OBB -> Acquire (Ptr XYZ)
OBB.yDirection Ptr OBB -> IO Double
OBB.yHSize
    
-- | the "Z" side of the oriented bounding box
--
-- This is measured from the center to one face.
-- So the length of this vector is _half_ of the side length of the bounding box.
obbSideZ :: OrientedBoundingBox -> V3 Double
obbSideZ :: OrientedBoundingBox -> V3 Double
obbSideZ =  (Ptr OBB -> Acquire (Ptr XYZ))
-> (Ptr OBB -> IO Double) -> OrientedBoundingBox -> V3 Double
getSide Ptr OBB -> Acquire (Ptr XYZ)
OBB.zDirection Ptr OBB -> IO Double
OBB.zHSize

-- | Reify an `OrientedBoundingBox` as a `Solid`
obbToSolid :: OrientedBoundingBox -> Solid
obbToSolid :: OrientedBoundingBox -> Solid
obbToSolid OrientedBoundingBox
obb = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
    Ptr OBB
obb' <- Ptr OBB -> Acquire (Ptr OBB)
forall a. a -> Acquire a
toAcquire (Ptr OBB -> Acquire (Ptr OBB))
-> (OrientedBoundingBox -> Ptr OBB)
-> OrientedBoundingBox
-> Acquire (Ptr OBB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrientedBoundingBox -> Ptr OBB
rawOBB (OrientedBoundingBox -> Acquire (Ptr OBB))
-> OrientedBoundingBox -> Acquire (Ptr OBB)
forall a b. (a -> b) -> a -> b
$ OrientedBoundingBox
obb
    Double
x <- IO Double -> Acquire Double
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Acquire Double)
-> (Ptr OBB -> IO Double) -> Ptr OBB -> Acquire Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr OBB -> IO Double
OBB.xHSize (Ptr OBB -> Acquire Double) -> Ptr OBB -> Acquire Double
forall a b. (a -> b) -> a -> b
$ Ptr OBB
obb'
    Double
y <- IO Double -> Acquire Double
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Acquire Double)
-> (Ptr OBB -> IO Double) -> Ptr OBB -> Acquire Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr OBB -> IO Double
OBB.yHSize (Ptr OBB -> Acquire Double) -> Ptr OBB -> Acquire Double
forall a b. (a -> b) -> a -> b
$ Ptr OBB
obb'
    Double
z <- IO Double -> Acquire Double
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Acquire Double)
-> (Ptr OBB -> IO Double) -> Ptr OBB -> Acquire Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr OBB -> IO Double
OBB.zHSize (Ptr OBB -> Acquire Double) -> Ptr OBB -> Acquire Double
forall a b. (a -> b) -> a -> b
$ Ptr OBB
obb'
    let halfBox :: V3 Double
halfBox = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
x Double
y Double
z
    Ptr Shape
unpositioned <- Solid -> Acquire (Ptr Shape)
acquireSolid (Solid -> Acquire (Ptr Shape))
-> (Solid -> Solid) -> Solid -> Acquire (Ptr Shape)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> Solid -> Solid
forall a. Transformable a => V3 Double -> a -> a
translate (V3 Double -> V3 Double
forall a. Num a => a -> a
negate V3 Double
halfBox) (Solid -> Acquire (Ptr Shape)) -> Solid -> Acquire (Ptr Shape)
forall a b. (a -> b) -> a -> b
$ V3 Double -> Solid
box (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
x Double
y Double
z V3 Double -> Double -> V3 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Double
2)
    Ptr Ax3
position <- Ptr OBB -> Acquire (Ptr Ax3)
OBB.position Ptr OBB
obb'
    Ptr Ax3
o <- Ptr Ax2 -> Acquire (Ptr Ax3)
Ax3.fromAx2 (Ptr Ax2 -> Acquire (Ptr Ax3))
-> Acquire (Ptr Ax2) -> Acquire (Ptr Ax3)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Acquire (Ptr Ax2)
GP.xoy
    Ptr Trsf
trsf <- Acquire (Ptr Trsf)
Trsf.new
    IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr Trsf -> Ptr Ax3 -> Ptr Ax3 -> IO ()
Trsf.setDisplacement Ptr Trsf
trsf Ptr Ax3
o Ptr Ax3
position
    Ptr Shape -> Ptr Trsf -> Bool -> Acquire (Ptr Shape)
BRepBuilderAPI.Transform.transform Ptr Shape
unpositioned Ptr Trsf
trsf Bool
True