module Waterfall.Offset
( offset
) where
import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)
import qualified OpenCascade.BRepOffsetAPI.MakeOffsetShape as MakeOffsetShape
import Control.Monad.IO.Class (liftIO)
import OpenCascade.Inheritance (SubTypeOf(upcast), unsafeDowncast)
import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape
import qualified OpenCascade.BRepOffset.Mode as Mode
import qualified OpenCascade.GeomAbs.JoinType as GeomAbs.JoinType
import qualified OpenCascade.BRepBuilderAPI.MakeSolid as MakeSolid
import qualified OpenCascade.TopoDS.Types as TopoDS
import qualified OpenCascade.TopExp.Explorer as TopExp.Explorer
import qualified OpenCascade.TopAbs.ShapeEnum as TopAbs.ShapeEnum
import Control.Monad (when)
import Foreign.Ptr (Ptr)
import Data.Acquire (Acquire)
import Linear.Epsilon (nearZero)
combineShellsToSolid :: Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape)
combineShellsToSolid :: Ptr Shape -> Acquire (Ptr Shape)
combineShellsToSolid Ptr Shape
s = do
Ptr Explorer
explorer <- Ptr Shape -> ShapeEnum -> Acquire (Ptr Explorer)
TopExp.Explorer.new Ptr Shape
s ShapeEnum
TopAbs.ShapeEnum.Shell
Ptr MakeSolid
makeSolid <- Acquire (Ptr MakeSolid)
MakeSolid.new
let go :: Acquire ()
go = do
Bool
isMore <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr Explorer -> IO Bool
TopExp.Explorer.more Ptr Explorer
explorer
Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isMore (Acquire () -> Acquire ()) -> Acquire () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ do
Ptr Shell
shell <- IO (Ptr Shell) -> Acquire (Ptr Shell)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Shell) -> Acquire (Ptr Shell))
-> IO (Ptr Shell) -> Acquire (Ptr Shell)
forall a b. (a -> b) -> a -> b
$ Ptr Shape -> IO (Ptr Shell)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast (Ptr Shape -> IO (Ptr Shell)) -> IO (Ptr Shape) -> IO (Ptr Shell)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Explorer -> IO (Ptr Shape)
TopExp.Explorer.value Ptr Explorer
explorer
IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr MakeSolid -> Ptr Shell -> IO ()
MakeSolid.add Ptr MakeSolid
makeSolid Ptr Shell
shell
IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr Explorer -> IO ()
TopExp.Explorer.next Ptr Explorer
explorer
Acquire ()
go
Acquire ()
go
Ptr Solid -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast (Ptr Solid -> Ptr Shape)
-> Acquire (Ptr Solid) -> Acquire (Ptr Shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MakeSolid -> Acquire (Ptr Solid)
MakeSolid.solid Ptr MakeSolid
makeSolid
offset :: Double
-> Double
-> Solid
-> Solid
offset :: Double -> Double -> Solid -> Solid
offset Double
value Double
tolerance Solid
solid
| Double -> Bool
forall a. Epsilon a => a -> Bool
nearZero Double
value = Solid
solid
| Bool
otherwise =
Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr MakeOffsetShape
builder <- Acquire (Ptr MakeOffsetShape)
MakeOffsetShape.new
Ptr Shape
s <- Solid -> Acquire (Ptr Shape)
acquireSolid Solid
solid
IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr MakeOffsetShape
-> Ptr Shape
-> Double
-> Double
-> Mode
-> Bool
-> Bool
-> JoinType
-> Bool
-> IO ()
MakeOffsetShape.performByJoin Ptr MakeOffsetShape
builder Ptr Shape
s Double
value Double
tolerance Mode
Mode.Skin Bool
False Bool
False JoinType
GeomAbs.JoinType.Arc Bool
False
Ptr Shape
shell <- Ptr MakeShape -> Acquire (Ptr Shape)
MakeShape.shape (Ptr MakeOffsetShape -> Ptr MakeShape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr MakeOffsetShape
builder)
Ptr Shape -> Acquire (Ptr Shape)
combineShellsToSolid Ptr Shape
shell