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 v face = let vn = normalize v z = unit _z in if nearZero (vn - z) then pure face else let axis = if nearZero (vn + z) then unit _x else z `cross` vn angle = acos (vn `dot` z) in acquireSolid . rotate axis angle . solidFromAcquire . pure $ face positionFace :: V3 Double -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape) positionFace p = acquireSolid . translate p . solidFromAcquire . pure -- | Sweep a 2D `Shape` along a `Path`, constructing a `Solid` sweep :: Path -> Shape -> Solid sweep (Path theRawPath) (Shape theRawShape) = solidFromAcquire $ do path <- toAcquire 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)