module Waterfall.Sweep
( sweep
, trySweep
) where

import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire, solidFromAcquireWithCatch)
import Waterfall.Internal.Path (Path (..))
import Waterfall.Internal.Path.Common (RawPath (..))
import Waterfall.Internal.Edges (wireTangentStart, wireEndpoints)
import Waterfall.Internal.Finalizers (toAcquire)
import Waterfall.Internal.NearZero (nearZero)
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, cross, dot)
import Data.Acquire (Acquire)
import Waterfall.Error (WaterfallError)
import Data.Either (fromRight)

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 (Double -> Bool) -> V3 Double -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> 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 (Double -> Bool) -> V3 Double -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> 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


-- | Version of `sweep` that returns an Error on Failure
trySweep :: Path -> Shape -> Either WaterfallError Solid
trySweep :: Path -> Shape -> Either WaterfallError Solid
trySweep (Path (ComplexRawPath Ptr Wire
theRawPath)) (Shape Ptr Shape
theRawShape) = Acquire (Ptr Shape) -> Either WaterfallError Solid
solidFromAcquireWithCatch (Acquire (Ptr Shape) -> Either WaterfallError Solid)
-> Acquire (Ptr Shape) -> Either WaterfallError 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)
wireTangentStart 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)
trySweep Path
_ Shape
_ = Solid -> Either WaterfallError Solid
forall a b. b -> Either a b
Right Solid
forall a. Monoid a => a
mempty


-- | Sweep a 2D `Shape` along a `Path`, constructing a `Solid`
sweep :: Path -> Shape -> Solid
sweep :: Path -> Shape -> Solid
sweep Path
path Shape
shape = Solid -> Either WaterfallError Solid -> Solid
forall b a. b -> Either a b -> b
fromRight Solid
forall a. Monoid a => a
mempty (Either WaterfallError Solid -> Solid)
-> Either WaterfallError Solid -> Solid
forall a b. (a -> b) -> a -> b
$ Path -> Shape -> Either WaterfallError Solid
trySweep Path
path Shape
shape