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 ((<=<))
data OrientedBoundingBox = OrientedBoundingBox { OrientedBoundingBox -> Ptr OBB
rawOBB :: Ptr OBB }
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
obb <- Acquire (Ptr OBB)
OBB.new
solid <- acquireSolid s
liftIO $ BRepBndLib.addOBB solid obb True True True
return 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)
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
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
len <- liftIO $ fLength obb
return $ normalize side ^* len
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
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
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
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
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
x <- liftIO . OBB.xHSize $ obb'
y <- liftIO . OBB.yHSize $ obb'
z <- liftIO . OBB.zHSize $ obb'
let halfBox = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
x Double
y Double
z
unpositioned <- acquireSolid . translate (negate halfBox) $ box (V3 x y z ^* 2)
position <- OBB.position obb'
o <- Ax3.fromAx2 =<< GP.xoy
trsf <- Trsf.new
liftIO $ Trsf.setDisplacement trsf o position
BRepBuilderAPI.Transform.transform unpositioned trsf True