module Waterfall.Solids 
( Solid
, nowhere
, unitCube
, centeredCube
, box
, unitSphere
, unitCylinder
, centeredCylinder
, unitCone
, prism
, volume
, centerOfMass
, momentOfInertia
) where


import Waterfall.Internal.Solid (Solid (..), solidFromAcquire, acquireSolid, nowhere)
import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)
import Waterfall.TwoD.Internal.Shape (rawShape)
import Waterfall.Internal.FromOpenCascade (gpPntToV3)
import Waterfall.Transforms (translate)
import qualified Waterfall.TwoD.Shape as TwoD.Shape
import qualified OpenCascade.BRepPrimAPI.MakeBox as MakeBox
import qualified OpenCascade.BRepPrimAPI.MakeSphere as MakeSphere
import qualified OpenCascade.BRepPrimAPI.MakeCylinder as MakeCylinder
import qualified OpenCascade.BRepPrimAPI.MakeCone as MakeCone
import qualified OpenCascade.GProp.GProps as GProps
import qualified OpenCascade.BRepGProp as BRepGProp
import qualified OpenCascade.GP as GP
import Control.Lens ((^.))
import Linear (V3 (..), unit, _x, _y, _z, (^*))
import qualified OpenCascade.GP.Pnt as GP.Pnt
import qualified OpenCascade.GP.Vec as GP.Vec
import qualified OpenCascade.GP.Dir as GP.Dir
import qualified OpenCascade.GP.Ax1 as GP.Ax1
import qualified OpenCascade.BRepPrimAPI.MakePrism as MakePrism
import qualified OpenCascade.Inheritance as Inheritance

import Control.Monad.IO.Class (liftIO)
import Control.Monad ((<=<))
import Foreign.Ptr (Ptr)
import Data.Acquire (Acquire)

-- | A cube with side lengths of 1, one vertex on the origin, another on \( (1, 1, 1) \)
unitCube :: Solid
unitCube :: Solid
unitCube = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
a <- Acquire (Ptr Pnt)
GP.origin
    Ptr Pnt
b <- Double -> Double -> Double -> Acquire (Ptr Pnt)
GP.Pnt.new Double
1 Double
1 Double
1
    Ptr MakeBox
builder <- Ptr Pnt -> Ptr Pnt -> Acquire (Ptr MakeBox)
MakeBox.fromPnts Ptr Pnt
a Ptr Pnt
b
    Ptr Solid -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
Inheritance.upcast (Ptr Solid -> Ptr Shape)
-> Acquire (Ptr Solid) -> Acquire (Ptr Shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MakeBox -> Acquire (Ptr Solid)
MakeBox.solid Ptr MakeBox
builder

-- | A cube with side lengths of 1, centered on the origin
centeredCube :: Solid
centeredCube :: Solid
centeredCube = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
a <- Double -> Double -> Double -> Acquire (Ptr Pnt)
GP.Pnt.new (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
    Ptr Pnt
b <- Double -> Double -> Double -> Acquire (Ptr Pnt)
GP.Pnt.new (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
    Ptr MakeBox
builder <- Ptr Pnt -> Ptr Pnt -> Acquire (Ptr MakeBox)
MakeBox.fromPnts Ptr Pnt
a Ptr Pnt
b
    Ptr Solid -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
Inheritance.upcast (Ptr Solid -> Ptr Shape)
-> Acquire (Ptr Solid) -> Acquire (Ptr Shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MakeBox -> Acquire (Ptr Solid)
MakeBox.solid Ptr MakeBox
builder

-- | A cuboid, one vertex on the origin, another on a given point
box :: V3 Double -> Solid
box :: V3 Double -> Solid
box (V3 Double
x Double
y Double
z) = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
a <- Acquire (Ptr Pnt)
GP.origin
    Ptr Pnt
b <- Double -> Double -> Double -> Acquire (Ptr Pnt)
GP.Pnt.new Double
x Double
y Double
z
    Ptr MakeBox
builder <- Ptr Pnt -> Ptr Pnt -> Acquire (Ptr MakeBox)
MakeBox.fromPnts Ptr Pnt
a Ptr Pnt
b
    Ptr Solid -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
Inheritance.upcast (Ptr Solid -> Ptr Shape)
-> Acquire (Ptr Solid) -> Acquire (Ptr Shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MakeBox -> Acquire (Ptr Solid)
MakeBox.solid Ptr MakeBox
builder

    
-- | A sphere with radius of 1, centered on the origin
unitSphere :: Solid
unitSphere :: Solid
unitSphere = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ Ptr Solid -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
Inheritance.upcast (Ptr Solid -> Ptr Shape)
-> Acquire (Ptr Solid) -> Acquire (Ptr Shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Acquire (Ptr Solid)
MakeSphere.fromRadius Double
1

-- | A cylinder with radius 1, length 1,
-- one of it's circular faces centered on the origin,
-- the other centered on \( (0, 0, 1) \)
unitCylinder :: Solid
unitCylinder :: Solid
unitCylinder = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ Ptr Solid -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
Inheritance.upcast (Ptr Solid -> Ptr Shape)
-> Acquire (Ptr Solid) -> Acquire (Ptr Shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Double -> Acquire (Ptr Solid)
MakeCylinder.fromRadiusAndHeight Double
1 Double
1

-- | A cylinder with radius 1, length 1,
-- centered on the origin,
centeredCylinder :: Solid
centeredCylinder :: Solid
centeredCylinder = V3 Double -> Solid -> Solid
forall a. Transformable a => V3 Double -> a -> a
translate (ASetter' (V3 Double) Double -> V3 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z V3 Double -> Double -> V3 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (-Double
0.5)) (Solid -> Solid) -> Solid -> Solid
forall a b. (a -> b) -> a -> b
$ Solid
unitCylinder

-- | A cone 
-- With a point at the origin 
-- and a circular face with Radius 1, centered on \( (0, 0, 1) \)
unitCone :: Solid
unitCone :: Solid
unitCone = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ Ptr Solid -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
Inheritance.upcast (Ptr Solid -> Ptr Shape)
-> Acquire (Ptr Solid) -> Acquire (Ptr Shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Double -> Double -> Acquire (Ptr Solid)
MakeCone.fromTwoRadiiAndHeight Double
0 Double
1 Double
1

-- | Extruded a 2D face into a prism with a given length \(len\).
--
-- One of the prisms faces lies on the plane \(z = 0\),
-- the other on the plane \(z = len\).
prism :: Double -> TwoD.Shape.Shape -> Solid
prism :: Double -> Shape -> Solid
prism Double
len Shape
face = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
    Ptr Shape
p <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire (Ptr Shape -> Acquire (Ptr Shape))
-> (Shape -> Ptr Shape) -> Shape -> Acquire (Ptr Shape)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shape -> Ptr Shape
rawShape (Shape -> Acquire (Ptr Shape)) -> Shape -> Acquire (Ptr Shape)
forall a b. (a -> b) -> a -> b
$ Shape
face
    Ptr Vec
v <- Double -> Double -> Double -> Acquire (Ptr Vec)
GP.Vec.new Double
0 Double
0 Double
len
    Ptr Shape -> Ptr Vec -> Bool -> Bool -> Acquire (Ptr Shape)
MakePrism.fromVec Ptr Shape
p Ptr Vec
v Bool
True Bool
True

gPropQuery :: (Ptr GProps.GProps -> Acquire a) -> Solid -> a
gPropQuery :: forall a. (Ptr GProps -> Acquire a) -> Solid -> a
gPropQuery Ptr GProps -> Acquire a
f Solid
s = Acquire a -> a
forall a. Acquire a -> a
unsafeFromAcquire (Acquire a -> a) -> Acquire a -> a
forall a b. (a -> b) -> a -> b
$ do
    Ptr Shape
solid <- Solid -> Acquire (Ptr Shape)
acquireSolid Solid
s
    Ptr GProps
gProp <- Acquire (Ptr GProps)
GProps.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 Shape -> Ptr GProps -> Bool -> Bool -> Bool -> IO ()
BRepGProp.volumeProperties Ptr Shape
solid Ptr GProps
gProp Bool
False Bool
False Bool
False
    Ptr GProps -> Acquire a
f Ptr GProps
gProp

-- | Volume of the Solid
volume :: Solid -> Double
volume :: Solid -> Double
volume = (Ptr GProps -> Acquire Double) -> Solid -> Double
forall a. (Ptr GProps -> Acquire a) -> Solid -> a
gPropQuery (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 GProps -> IO Double) -> Ptr GProps -> Acquire Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr GProps -> IO Double
GProps.mass)

-- | Center Of Mass of the Solid
centerOfMass :: Solid -> V3 Double 
centerOfMass :: Solid -> V3 Double
centerOfMass = (Ptr GProps -> Acquire (V3 Double)) -> Solid -> V3 Double
forall a. (Ptr GProps -> Acquire a) -> Solid -> a
gPropQuery ((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 Pnt -> IO (V3 Double)) -> Ptr Pnt -> Acquire (V3 Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Pnt -> IO (V3 Double)
gpPntToV3) (Ptr Pnt -> Acquire (V3 Double))
-> (Ptr GProps -> Acquire (Ptr Pnt))
-> Ptr GProps
-> Acquire (V3 Double)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr GProps -> Acquire (Ptr Pnt)
GProps.centreOfMass)

-- | Moment of Inertia of the Solid around a particular point and axis
momentOfInertia :: V3 Double -- ^ Point on the Axis of the Moment
    -> V3 Double -- ^ Direction of the Axis of the Moment 
    -> Solid
    -> Double 
momentOfInertia :: V3 Double -> V3 Double -> Solid -> Double
momentOfInertia V3 Double
center V3 Double
axis = (Ptr GProps -> Acquire Double) -> Solid -> Double
forall a. (Ptr GProps -> Acquire a) -> Solid -> a
gPropQuery ((Ptr GProps -> Acquire Double) -> Solid -> Double)
-> (Ptr GProps -> Acquire Double) -> Solid -> Double
forall a b. (a -> b) -> a -> b
$ \Ptr GProps
gprop -> do
    Ptr Pnt
pnt <- Double -> Double -> Double -> Acquire (Ptr Pnt)
GP.Pnt.new (V3 Double
center V3 Double -> Getting Double (V3 Double) Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) (V3 Double
center V3 Double -> Getting Double (V3 Double) Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) (V3 Double
center V3 Double -> Getting Double (V3 Double) Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)
    Ptr Dir
dir <- Double -> Double -> Double -> Acquire (Ptr Dir)
GP.Dir.new (V3 Double
axis V3 Double -> Getting Double (V3 Double) Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) (V3 Double
axis V3 Double -> Getting Double (V3 Double) Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) (V3 Double
axis V3 Double -> Getting Double (V3 Double) Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)
    Ptr Ax1
ax1 <- Ptr Pnt -> Ptr Dir -> Acquire (Ptr Ax1)
GP.Ax1.new Ptr Pnt
pnt Ptr Dir
dir
    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 GProps -> Ptr Ax1 -> IO Double
GProps.momentOfInertia Ptr GProps
gprop Ptr Ax1
ax1