module Waterfall.Internal.Edges ( edgeEndpoints , wireEndpoints , wireTangent ) where import qualified OpenCascade.TopoDS as TopoDS import qualified OpenCascade.BRep.Tool as BRep.Tool import qualified OpenCascade.Geom.Curve as Geom.Curve import qualified OpenCascade.BRepTools.WireExplorer as WireExplorer import Waterfall.Internal.FromOpenCascade (gpPntToV3, gpVecToV3) import Data.Acquire import Control.Monad.IO.Class (liftIO) import Linear (V3 (..)) import Foreign.Ptr edgeEndpoints :: Ptr TopoDS.Edge -> IO (V3 Double, V3 Double) edgeEndpoints :: Ptr Edge -> IO (V3 Double, V3 Double) edgeEndpoints Ptr Edge edge = (Acquire (V3 Double, V3 Double) -> ((V3 Double, V3 Double) -> IO (V3 Double, V3 Double)) -> IO (V3 Double, V3 Double) forall (m :: * -> *) a b. MonadUnliftIO m => Acquire a -> (a -> m b) -> m b `with` (V3 Double, V3 Double) -> IO (V3 Double, V3 Double) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure) (Acquire (V3 Double, V3 Double) -> IO (V3 Double, V3 Double)) -> Acquire (V3 Double, V3 Double) -> IO (V3 Double, V3 Double) forall a b. (a -> b) -> a -> b $ do Ptr (Handle Curve) curve <- Ptr Edge -> Acquire (Ptr (Handle Curve)) BRep.Tool.curve Ptr Edge edge Double p1 <- IO Double -> Acquire Double forall a. IO a -> Acquire a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Double -> Acquire Double) -> (Ptr Edge -> IO Double) -> Ptr Edge -> Acquire Double forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr Edge -> IO Double BRep.Tool.curveParamFirst (Ptr Edge -> Acquire Double) -> Ptr Edge -> Acquire Double forall a b. (a -> b) -> a -> b $ Ptr Edge edge Double p2 <- IO Double -> Acquire Double forall a. IO a -> Acquire a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Double -> Acquire Double) -> (Ptr Edge -> IO Double) -> Ptr Edge -> Acquire Double forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr Edge -> IO Double BRep.Tool.curveParamLast (Ptr Edge -> Acquire Double) -> Ptr Edge -> Acquire Double forall a b. (a -> b) -> a -> b $ Ptr Edge edge V3 Double s <- (IO (V3 Double) -> Acquire (V3 Double) forall a. IO a -> Acquire a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (V3 Double) -> Acquire (V3 Double)) -> (Ptr Pnt -> IO (V3 Double)) -> Ptr Pnt -> Acquire (V3 Double) forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr Pnt -> IO (V3 Double) gpPntToV3) (Ptr Pnt -> Acquire (V3 Double)) -> Acquire (Ptr Pnt) -> Acquire (V3 Double) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr (Handle Curve) -> Double -> Acquire (Ptr Pnt) Geom.Curve.value Ptr (Handle Curve) curve Double p1 V3 Double e <- (IO (V3 Double) -> Acquire (V3 Double) forall a. IO a -> Acquire a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (V3 Double) -> Acquire (V3 Double)) -> (Ptr Pnt -> IO (V3 Double)) -> Ptr Pnt -> Acquire (V3 Double) forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr Pnt -> IO (V3 Double) gpPntToV3) (Ptr Pnt -> Acquire (V3 Double)) -> Acquire (Ptr Pnt) -> Acquire (V3 Double) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr (Handle Curve) -> Double -> Acquire (Ptr Pnt) Geom.Curve.value Ptr (Handle Curve) curve Double p2 (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double) forall a. a -> Acquire a forall (m :: * -> *) a. Monad m => a -> m a return (V3 Double s, V3 Double e) wireEndpoints :: Ptr TopoDS.Wire -> IO (V3 Double, V3 Double) wireEndpoints :: Ptr Wire -> IO (V3 Double, V3 Double) wireEndpoints Ptr Wire wire = Acquire (Ptr WireExplorer) -> (Ptr WireExplorer -> IO (V3 Double, V3 Double)) -> IO (V3 Double, V3 Double) forall (m :: * -> *) a b. MonadUnliftIO m => Acquire a -> (a -> m b) -> m b with (Ptr Wire -> Acquire (Ptr WireExplorer) WireExplorer.fromWire Ptr Wire wire) ((Ptr WireExplorer -> IO (V3 Double, V3 Double)) -> IO (V3 Double, V3 Double)) -> (Ptr WireExplorer -> IO (V3 Double, V3 Double)) -> IO (V3 Double, V3 Double) forall a b. (a -> b) -> a -> b $ \Ptr WireExplorer explorer -> do Ptr Edge v1 <- Ptr WireExplorer -> IO (Ptr Edge) WireExplorer.current Ptr WireExplorer explorer (V3 Double s, V3 Double _) <- Ptr Edge -> IO (V3 Double, V3 Double) edgeEndpoints Ptr Edge v1 let runToEnd :: IO (V3 Double) runToEnd = do Ptr Edge edge <- Ptr WireExplorer -> IO (Ptr Edge) WireExplorer.current Ptr WireExplorer explorer (V3 Double _s, V3 Double e') <- Ptr Edge -> IO (V3 Double, V3 Double) edgeEndpoints Ptr Edge edge Ptr WireExplorer -> IO () WireExplorer.next Ptr WireExplorer explorer Bool more <- Ptr WireExplorer -> IO Bool WireExplorer.more Ptr WireExplorer explorer if Bool more then IO (V3 Double) runToEnd else V3 Double -> IO (V3 Double) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure V3 Double e' V3 Double e <- IO (V3 Double) runToEnd (V3 Double, V3 Double) -> IO (V3 Double, V3 Double) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (V3 Double s, V3 Double e) edgeTangent :: Ptr TopoDS.Edge -> IO (V3 Double) edgeTangent :: Ptr Edge -> IO (V3 Double) edgeTangent Ptr Edge e = (Acquire (V3 Double) -> (V3 Double -> IO (V3 Double)) -> IO (V3 Double) forall (m :: * -> *) a b. MonadUnliftIO m => Acquire a -> (a -> m b) -> m b `with` V3 Double -> IO (V3 Double) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure) (Acquire (V3 Double) -> IO (V3 Double)) -> Acquire (V3 Double) -> IO (V3 Double) forall a b. (a -> b) -> a -> b $ do Ptr (Handle Curve) curve <- Ptr Edge -> Acquire (Ptr (Handle Curve)) BRep.Tool.curve Ptr Edge e Double p1 <- IO Double -> Acquire Double forall a. IO a -> Acquire a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Double -> Acquire Double) -> (Ptr Edge -> IO Double) -> Ptr Edge -> Acquire Double forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr Edge -> IO Double BRep.Tool.curveParamFirst (Ptr Edge -> Acquire Double) -> Ptr Edge -> Acquire Double forall a b. (a -> b) -> a -> b $ Ptr Edge e IO (V3 Double) -> Acquire (V3 Double) forall a. IO a -> Acquire a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (V3 Double) -> Acquire (V3 Double)) -> (Ptr Vec -> IO (V3 Double)) -> Ptr Vec -> Acquire (V3 Double) forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr Vec -> IO (V3 Double) gpVecToV3 (Ptr Vec -> Acquire (V3 Double)) -> Acquire (Ptr Vec) -> Acquire (V3 Double) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr (Handle Curve) -> Double -> Int -> Acquire (Ptr Vec) Geom.Curve.dn Ptr (Handle Curve) curve Double p1 Int 1 wireTangent :: Ptr TopoDS.Wire -> IO (V3 Double) wireTangent :: Ptr Wire -> IO (V3 Double) wireTangent Ptr Wire wire = Acquire (Ptr WireExplorer) -> (Ptr WireExplorer -> IO (V3 Double)) -> IO (V3 Double) forall (m :: * -> *) a b. MonadUnliftIO m => Acquire a -> (a -> m b) -> m b with (Ptr Wire -> Acquire (Ptr WireExplorer) WireExplorer.fromWire Ptr Wire wire) ((Ptr WireExplorer -> IO (V3 Double)) -> IO (V3 Double)) -> (Ptr WireExplorer -> IO (V3 Double)) -> IO (V3 Double) forall a b. (a -> b) -> a -> b $ \Ptr WireExplorer explorer -> do Ptr Edge v1 <- Ptr WireExplorer -> IO (Ptr Edge) WireExplorer.current Ptr WireExplorer explorer Ptr Edge -> IO (V3 Double) edgeTangent Ptr Edge v1