module Waterfall.Offset 
( offset
, offsetWithTolerance
-- * Functions that return Errors
, tryOffset
, tryOffsetWithTolerance
) where 

import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquireWithCatch)
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 Waterfall.Internal.NearZero (nearZero)
import Waterfall.Error (WaterfallError)
import Data.Either (fromRight)

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

-- | Version of `offsetWithTolerance` that returns an error on failure
tryOffsetWithTolerance :: 
    Double       
    -> Double   
    -> Solid   
    -> Either WaterfallError Solid
tryOffsetWithTolerance :: Double -> Double -> Solid -> Either WaterfallError Solid
tryOffsetWithTolerance Double
tolerance Double
value Solid
solid
    | Double -> Bool
nearZero Double
value = Solid -> Either WaterfallError Solid
forall a b. b -> Either a b
Right Solid
solid
    | Bool
otherwise = 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 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

offsetWithTolerance :: 
    Double       -- ^ Tolerance, this can be relatively small
    -> Double    -- ^ Amount to offset by, positive values expand, negative values contract
    -> Solid        -- ^ the `Solid` to offset 
    -> Solid
offsetWithTolerance :: Double -> Double -> Solid -> Solid
offsetWithTolerance Double
tolerance Double
value Solid
solid = 
    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
$ Double -> Double -> Solid -> Either WaterfallError Solid
tryOffsetWithTolerance Double
tolerance Double
value Solid
solid

defaultTolerance :: Double
defaultTolerance :: Double
defaultTolerance = Double
1e-6

-- | Expand or contract a `Solid` by a certain amount.
-- 
-- This is based on @MakeOffsetShape@ from the underlying OpenCascade library.
-- And as such, only supports the same set of `Solid`s that @MakeOffsetShape@ does.
--
-- The documentation for @MakeOffsetShape@ lists the following constraints
-- ( [link](https://dev.opencascade.org/doc/refman/html/class_b_rep_offset_a_p_i___make_offset_shape.html) ):
--
-- * All the faces of the shape S should be based on the surfaces with continuity at least C1.
-- * The offset value should be sufficiently small to avoid self-intersections in resulting shape.
--      Otherwise these self-intersections may appear inside an offset face if its initial surface is not plane or sphere or cylinder, also some non-adjacent offset faces may intersect each other. Also, some offset surfaces may "turn inside out".
-- * The algorithm may fail if the shape S contains vertices where more than 3 edges converge.
-- * Since 3d-offset algorithm involves intersection of surfaces, it is under limitations of surface intersection algorithm.
-- * A result cannot be generated if the underlying geometry of S is BSpline with continuity C0.
offset :: 
    Double    -- ^ Amount to offset by, positive values expand, negative values contract
    -> Solid        -- ^ the `Solid` to offset 
    -> Solid
offset :: Double -> Solid -> Solid
offset = Double -> Double -> Solid -> Solid
offsetWithTolerance Double
defaultTolerance


-- | Version of `offset` that returns an error on failure
tryOffset  :: 
    Double    -- ^ Amount to offset by, positive values expand, negative values contract
    -> Solid        -- ^ the `Solid` to offset 
    -> Either WaterfallError Solid
tryOffset :: Double -> Solid -> Either WaterfallError Solid
tryOffset = Double -> Double -> Solid -> Either WaterfallError Solid
tryOffsetWithTolerance Double
defaultTolerance