module Waterfall.Sweep
( sweep
) where

import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)
import Waterfall.Internal.Path (Path (..))
import Waterfall.Internal.Edges (wireTangent, wireEndpoints)
import Waterfall.Internal.Finalizers (toAcquire)
import Waterfall.Transforms (rotate, translate)
import Waterfall.TwoD.Internal.Shape (Shape (..))
import qualified OpenCascade.BRepOffsetAPI.MakePipe as MakePipe
import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape
import OpenCascade.Inheritance (upcast)
import qualified OpenCascade.TopoDS as TopoDS
import Control.Monad.IO.Class (liftIO)
import Foreign.Ptr
import Linear (V3, normalize, unit, _x, _z, nearZero, cross, dot)
import Data.Acquire (Acquire)

rotateFace :: V3 Double -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape)
rotateFace :: V3 Double -> Ptr Shape -> Acquire (Ptr Shape)
rotateFace V3 Double
v Ptr Shape
face = 
    let vn :: V3 Double
vn = V3 Double -> V3 Double
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize V3 Double
v
        z :: V3 Double
z = 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
        in if V3 Double -> Bool
forall a. Epsilon a => a -> Bool
nearZero (V3 Double
vn V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
- V3 Double
z)
            then Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Shape
face
            else
                let axis :: V3 Double
axis = if V3 Double -> Bool
forall a. Epsilon a => a -> Bool
nearZero (V3 Double
vn V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
+ V3 Double
z) then 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. R1 t => Lens' (t a) a
_x else V3 Double
z V3 Double -> V3 Double -> V3 Double
forall a. Num a => V3 a -> V3 a -> V3 a
`cross` V3 Double
vn
                    angle :: Double
angle = Double -> Double
forall a. Floating a => a -> a
acos (V3 Double
vn V3 Double -> V3 Double -> Double
forall a. Num a => V3 a -> V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V3 Double
z)
                in Solid -> Acquire (Ptr Shape)
acquireSolid (Solid -> Acquire (Ptr Shape))
-> (Ptr Shape -> Solid) -> Ptr Shape -> Acquire (Ptr Shape)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> Double -> Solid -> Solid
forall a. Transformable a => V3 Double -> Double -> a -> a
rotate V3 Double
axis Double
angle (Solid -> Solid) -> (Ptr Shape -> Solid) -> Ptr Shape -> Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid)
-> (Ptr Shape -> Acquire (Ptr Shape)) -> Ptr Shape -> Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Shape -> Acquire (Ptr Shape))
-> Ptr Shape -> Acquire (Ptr Shape)
forall a b. (a -> b) -> a -> b
$ Ptr Shape
face 

positionFace :: V3 Double -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape)
positionFace :: V3 Double -> Ptr Shape -> Acquire (Ptr Shape)
positionFace V3 Double
p = Solid -> Acquire (Ptr Shape)
acquireSolid (Solid -> Acquire (Ptr Shape))
-> (Ptr Shape -> Solid) -> Ptr Shape -> 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
p (Solid -> Solid) -> (Ptr Shape -> Solid) -> Ptr Shape -> Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid)
-> (Ptr Shape -> Acquire (Ptr Shape)) -> Ptr Shape -> Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Sweep a 2D `Shape` along a `Path`, constructing a `Solid`
sweep :: Path -> Shape -> Solid
sweep :: Path -> Shape -> Solid
sweep (Path Ptr Wire
theRawPath) (Shape Ptr Shape
theRawShape) = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
    Ptr Wire
path <- Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire Ptr Wire
theRawPath
    Ptr Shape
shape <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
theRawShape
    V3 Double
tangent <- 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))
-> IO (V3 Double) -> Acquire (V3 Double)
forall a b. (a -> b) -> a -> b
$ Ptr Wire -> IO (V3 Double)
wireTangent Ptr Wire
path
    (V3 Double
start,V3 Double
_)  <- IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double))
-> IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double)
forall a b. (a -> b) -> a -> b
$ Ptr Wire -> IO (V3 Double, V3 Double)
wireEndpoints Ptr Wire
path
    Ptr Shape
adjustedFace <- V3 Double -> Ptr Shape -> Acquire (Ptr Shape)
positionFace V3 Double
start (Ptr Shape -> Acquire (Ptr Shape))
-> Acquire (Ptr Shape) -> Acquire (Ptr Shape)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< V3 Double -> Ptr Shape -> Acquire (Ptr Shape)
rotateFace V3 Double
tangent Ptr Shape
shape
    Ptr MakePipe
builder <- Ptr Wire -> Ptr Shape -> Acquire (Ptr MakePipe)
MakePipe.fromWireAndShape Ptr Wire
path Ptr Shape
adjustedFace
    Ptr MakeShape -> Acquire (Ptr Shape)
MakeShape.shape (Ptr MakePipe -> Ptr MakeShape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr MakePipe
builder)