module Waterfall.Fillet
( roundFillet
, roundConditionalFillet
, roundIndexedConditionalFillet
) where
import Waterfall.Internal.Solid (Solid (..))
import Waterfall.Internal.Edges (edgeEndpoints)
import qualified OpenCascade.BRepFilletAPI.MakeFillet as MakeFillet
import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape
import qualified OpenCascade.TopExp.Explorer as Explorer
import qualified OpenCascade.TopAbs.ShapeEnum as ShapeEnum
import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape
import Foreign.Ptr (Ptr)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import OpenCascade.Inheritance (upcast, unsafeDowncast)
import Linear.V3 (V3 (..))
addEdgesToMakeFillet :: (Integer -> (V3 Double, V3 Double) -> Maybe Double) -> Ptr MakeFillet.MakeFillet -> Ptr Explorer.Explorer -> IO ()
addEdgesToMakeFillet :: (Integer -> (V3 Double, V3 Double) -> Maybe Double)
-> Ptr MakeFillet -> Ptr Explorer -> IO ()
addEdgesToMakeFillet Integer -> (V3 Double, V3 Double) -> Maybe Double
radiusFn Ptr MakeFillet
builder 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 -> Int -> IO Int
TopoDS.Shape.hashCode (Ptr Edge -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Edge
v) (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
31 :: Int))
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 -> Ptr MakeFillet -> Double -> Ptr Edge -> IO ()
MakeFillet.addEdgeWithRadius Ptr MakeFillet
builder 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)
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 Acquire (Ptr Shape)
run) = Acquire (Ptr Shape) -> Solid
Solid (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr Shape
s <- Acquire (Ptr Shape)
run
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)
-> Ptr MakeFillet -> Ptr Explorer -> IO ()
addEdgesToMakeFillet Integer -> (V3 Double, V3 Double) -> Maybe Double
radiusFunction 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)
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)
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)