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
    path <- Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire Ptr Wire
theRawPath
    shape <- toAcquire theRawShape
    tangent <- liftIO $ wireTangent path
    (start,_)  <- liftIO $ wireEndpoints path
    adjustedFace <- positionFace start =<< rotateFace tangent shape
    builder <- MakePipe.fromWireAndShape path adjustedFace
    MakeShape.shape (upcast builder)