module Waterfall.Fillet
( roundFillet
, roundConditionalFillet
, roundIndexedConditionalFillet
, chamfer
, conditionalChamfer
, indexedConditionalChamfer
) where

import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)
import Waterfall.Internal.Edges (edgeEndpoints)
import qualified OpenCascade.BRepFilletAPI.MakeFillet as MakeFillet
import qualified OpenCascade.BRepFilletAPI.MakeChamfer as MakeChamfer
import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape
import qualified OpenCascade.TopExp.Explorer as Explorer 
import qualified OpenCascade.TopAbs.ShapeEnum as ShapeEnum
import qualified OpenCascade.TopTools.ShapeMapHasher as TopTools.ShapeMapHasher
import qualified OpenCascade.TopoDS.Types as TopoDS
import Foreign.Ptr (Ptr)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import OpenCascade.Inheritance (upcast, unsafeDowncast)
import Linear.V3 (V3 (..))

addEdges :: (Integer -> (V3 Double, V3 Double) -> Maybe Double) -> (Double -> Ptr TopoDS.Edge -> IO ()) -> Ptr Explorer.Explorer -> IO ()
addEdges :: (Integer -> (V3 Double, V3 Double) -> Maybe Double)
-> (Double -> Ptr Edge -> IO ()) -> Ptr Explorer -> IO ()
addEdges Integer -> (V3 Double, V3 Double) -> Maybe Double
radiusFn Double -> Ptr Edge -> IO ()
action Ptr Explorer
explorer = [Int] -> Integer -> IO ()
go [] Integer
0
    where go :: [Int] -> Integer -> IO ()
go [Int]
visited Integer
i = do
            Bool
isMore <- Ptr Explorer -> IO Bool
Explorer.more Ptr Explorer
explorer
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isMore (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Ptr Edge
v <- Ptr Shape -> IO (Ptr Edge)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast (Ptr Shape -> IO (Ptr Edge)) -> IO (Ptr Shape) -> IO (Ptr Edge)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Explorer -> IO (Ptr Shape)
Explorer.value Ptr Explorer
explorer
                Int
hash <- Ptr Shape -> IO Int
TopTools.ShapeMapHasher.hash (Ptr Edge -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Edge
v)
                if Int
hash Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
visited
                    then do
                        Ptr Explorer -> IO ()
Explorer.next Ptr Explorer
explorer
                        [Int] -> Integer -> IO ()
go [Int]
visited Integer
i
                    else do
                        (V3 Double, V3 Double)
endpoints <- Ptr Edge -> IO (V3 Double, V3 Double)
edgeEndpoints Ptr Edge
v
                        case Integer -> (V3 Double, V3 Double) -> Maybe Double
radiusFn Integer
i (V3 Double, V3 Double)
endpoints of 
                            Just Double
r | Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 -> Double -> Ptr Edge -> IO ()
action Double
r Ptr Edge
v
                            Maybe Double
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        Ptr Explorer -> IO ()
Explorer.next Ptr Explorer
explorer
                        [Int] -> Integer -> IO ()
go (Int
hashInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
visited) (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) 

-- | Add rounds with the given radius to each edge of a solid, conditional on the endpoints of the edge, and the index of the edge.
-- 
-- This can be used to selectively round\/fillet a `Solid`.
--
-- In general, relying on the edge index is inelegant,
-- however, if you consider a Solid with a semicircular face, 
-- there's no way to select either the curved or the flat edge of the semicircle based on just the endpoints.
--
-- Being able to selectively round\/fillet based on edge index is an \"easy\" way to round\/fillet these shapes. 
roundIndexedConditionalFillet :: (Integer -> (V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid
roundIndexedConditionalFillet :: (Integer -> (V3 Double, V3 Double) -> Maybe Double)
-> Solid -> Solid
roundIndexedConditionalFillet Integer -> (V3 Double, V3 Double) -> Maybe Double
radiusFunction Solid
solid = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
    Ptr Shape
s <- Solid -> Acquire (Ptr Shape)
acquireSolid Solid
solid
    Ptr MakeFillet
builder <- Ptr Shape -> Acquire (Ptr MakeFillet)
MakeFillet.fromShape Ptr Shape
s

    Ptr Explorer
explorer <- Ptr Shape -> ShapeEnum -> Acquire (Ptr Explorer)
Explorer.new Ptr Shape
s ShapeEnum
ShapeEnum.Edge
    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
$ (Integer -> (V3 Double, V3 Double) -> Maybe Double)
-> (Double -> Ptr Edge -> IO ()) -> Ptr Explorer -> IO ()
addEdges Integer -> (V3 Double, V3 Double) -> Maybe Double
radiusFunction (Ptr MakeFillet -> Double -> Ptr Edge -> IO ()
MakeFillet.addEdgeWithRadius Ptr MakeFillet
builder) Ptr Explorer
explorer

    Ptr MakeShape -> Acquire (Ptr Shape)
MakeShape.shape (Ptr MakeFillet -> Ptr MakeShape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr MakeFillet
builder)

-- | Add rounds with the given radius to each edge of a solid, conditional on the endpoints of the edge.
-- 
-- This can be used to selectively round\/fillet a `Solid`.
roundConditionalFillet :: ((V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid
roundConditionalFillet :: ((V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid
roundConditionalFillet (V3 Double, V3 Double) -> Maybe Double
f = (Integer -> (V3 Double, V3 Double) -> Maybe Double)
-> Solid -> Solid
roundIndexedConditionalFillet (((V3 Double, V3 Double) -> Maybe Double)
-> Integer -> (V3 Double, V3 Double) -> Maybe Double
forall a b. a -> b -> a
const (V3 Double, V3 Double) -> Maybe Double
f)

-- | Add a round with a given radius to every edge of a solid
--
-- Because this is applied to both internal (concave) and external (convex) edges, it may technically produce both Rounds and Fillets
roundFillet :: Double -> Solid -> Solid
roundFillet :: Double -> Solid -> Solid
roundFillet Double
r = ((V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid
roundConditionalFillet (Maybe Double -> (V3 Double, V3 Double) -> Maybe Double
forall a b. a -> b -> a
const (Maybe Double -> (V3 Double, V3 Double) -> Maybe Double)
-> (Double -> Maybe Double)
-> Double
-> (V3 Double, V3 Double)
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Maybe Double
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> (V3 Double, V3 Double) -> Maybe Double)
-> Double -> (V3 Double, V3 Double) -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
r)


-- | Add chamfers of the given size to each edge of a solid, conditional on the endpoints of the edge, and the index of the edge.
-- 
-- This can be used to selectively chamfer a `Solid`.
--
-- In general, relying on the edge index is inelegant,
-- however, if you consider a Solid with a semicircular face, 
-- there's no way to select either the curved or the flat edge of the semicircle based on just the endpoints.
--
-- Being able to selectively chamfer based on edge index is an \"easy\" way to chamfer these shapes. 
indexedConditionalChamfer :: (Integer -> (V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid
indexedConditionalChamfer :: (Integer -> (V3 Double, V3 Double) -> Maybe Double)
-> Solid -> Solid
indexedConditionalChamfer Integer -> (V3 Double, V3 Double) -> Maybe Double
radiusFunction Solid
solid = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
    Ptr Shape
s <- Solid -> Acquire (Ptr Shape)
acquireSolid Solid
solid
    Ptr MakeChamfer
builder <- Ptr Shape -> Acquire (Ptr MakeChamfer)
MakeChamfer.fromShape Ptr Shape
s

    Ptr Explorer
explorer <- Ptr Shape -> ShapeEnum -> Acquire (Ptr Explorer)
Explorer.new Ptr Shape
s ShapeEnum
ShapeEnum.Edge
    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
$ (Integer -> (V3 Double, V3 Double) -> Maybe Double)
-> (Double -> Ptr Edge -> IO ()) -> Ptr Explorer -> IO ()
addEdges Integer -> (V3 Double, V3 Double) -> Maybe Double
radiusFunction (Ptr MakeChamfer -> Double -> Ptr Edge -> IO ()
MakeChamfer.addEdgeWithDistance Ptr MakeChamfer
builder) Ptr Explorer
explorer

    Ptr MakeShape -> Acquire (Ptr Shape)
MakeShape.shape (Ptr MakeChamfer -> Ptr MakeShape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr MakeChamfer
builder)

-- | Add chamfers with the given size to each edge of a solid, conditional on the endpoints of the edge.
-- 
-- This can be used to selectively chamfer a `Solid`.
conditionalChamfer :: ((V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid
conditionalChamfer :: ((V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid
conditionalChamfer (V3 Double, V3 Double) -> Maybe Double
f = (Integer -> (V3 Double, V3 Double) -> Maybe Double)
-> Solid -> Solid
indexedConditionalChamfer (((V3 Double, V3 Double) -> Maybe Double)
-> Integer -> (V3 Double, V3 Double) -> Maybe Double
forall a b. a -> b -> a
const (V3 Double, V3 Double) -> Maybe Double
f)

-- | Add a round with a given radius to every edge of a solid
--
-- This is applied to both internal (concave) and external (convex) edges
chamfer :: Double -> Solid -> Solid
chamfer :: Double -> Solid -> Solid
chamfer Double
d = ((V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid
conditionalChamfer (Maybe Double -> (V3 Double, V3 Double) -> Maybe Double
forall a b. a -> b -> a
const (Maybe Double -> (V3 Double, V3 Double) -> Maybe Double)
-> (Double -> Maybe Double)
-> Double
-> (V3 Double, V3 Double)
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Maybe Double
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> (V3 Double, V3 Double) -> Maybe Double)
-> Double -> (V3 Double, V3 Double) -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
d)