module Waterfall.Loft
( pointedLoftWithPrecision
, pointedLoft
, loft
) where
import Linear (V3 (..))
import Waterfall.Internal.Path (Path, rawPath)
import Waterfall.Internal.Solid (Solid (..), solidFromAcquire)
import Waterfall.Internal.ToOpenCascade (v3ToVertex)
import Waterfall.Internal.Path.Common (rawPathWire)
import qualified OpenCascade.BRepOffsetAPI.ThruSections as ThruSections
import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape
import OpenCascade.Inheritance (upcast)
import Control.Monad.IO.Class (liftIO)
import Control.Monad (forM_, (<=<))
pointedLoftWithPrecision :: Double
-> Maybe (V3 Double)
-> [Path]
-> Maybe (V3 Double)
-> Solid
pointedLoftWithPrecision :: Double -> Maybe (V3 Double) -> [Path] -> Maybe (V3 Double) -> Solid
pointedLoftWithPrecision Double
precision Maybe (V3 Double)
start [Path]
paths Maybe (V3 Double)
end =
Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr ThruSections
thruSections <- Bool -> Bool -> Double -> Acquire (Ptr ThruSections)
ThruSections.new Bool
True Bool
False Double
precision
Maybe (V3 Double) -> (V3 Double -> Acquire ()) -> Acquire ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (V3 Double)
start ((IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (Ptr Vertex -> IO ()) -> Ptr Vertex -> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ThruSections -> Ptr Vertex -> IO ()
ThruSections.addVertex Ptr ThruSections
thruSections) (Ptr Vertex -> Acquire ())
-> (V3 Double -> Acquire (Ptr Vertex)) -> V3 Double -> Acquire ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< V3 Double -> Acquire (Ptr Vertex)
v3ToVertex)
[Path] -> (Path -> Acquire (Maybe ())) -> Acquire ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path]
paths ((Ptr Wire -> Acquire ()) -> Maybe (Ptr Wire) -> Acquire (Maybe ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (Ptr Wire -> IO ()) -> Ptr Wire -> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ThruSections -> Ptr Wire -> IO ()
ThruSections.addWire Ptr ThruSections
thruSections) (Maybe (Ptr Wire) -> Acquire (Maybe ()))
-> (Path -> Maybe (Ptr Wire)) -> Path -> Acquire (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawPath -> Maybe (Ptr Wire)
rawPathWire (RawPath -> Maybe (Ptr Wire))
-> (Path -> RawPath) -> Path -> Maybe (Ptr Wire)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> RawPath
rawPath)
Maybe (V3 Double) -> (V3 Double -> Acquire ()) -> Acquire ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (V3 Double)
end ((IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (Ptr Vertex -> IO ()) -> Ptr Vertex -> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ThruSections -> Ptr Vertex -> IO ()
ThruSections.addVertex Ptr ThruSections
thruSections) (Ptr Vertex -> Acquire ())
-> (V3 Double -> Acquire (Ptr Vertex)) -> V3 Double -> Acquire ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< V3 Double -> Acquire (Ptr Vertex)
v3ToVertex)
Ptr MakeShape -> Acquire (Ptr Shape)
MakeShape.shape (Ptr ThruSections -> Ptr MakeShape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr ThruSections
thruSections)
pointedLoft ::
Maybe (V3 Double)
-> [Path]
-> Maybe (V3 Double)
-> Solid
pointedLoft :: Maybe (V3 Double) -> [Path] -> Maybe (V3 Double) -> Solid
pointedLoft = Double -> Maybe (V3 Double) -> [Path] -> Maybe (V3 Double) -> Solid
pointedLoftWithPrecision Double
1e-6
loft ::
[Path]
-> Solid
loft :: [Path] -> Solid
loft [Path]
paths = Maybe (V3 Double) -> [Path] -> Maybe (V3 Double) -> Solid
pointedLoft Maybe (V3 Double)
forall a. Maybe a
Nothing [Path]
paths Maybe (V3 Double)
forall a. Maybe a
Nothing