module Waterfall.Internal.Edges ( gpPntToV3 , edgeEndpoints , wireEndpoints ) 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 qualified OpenCascade.GP.Pnt as GP.Pnt import qualified OpenCascade.GP as GP import Data.Acquire import Control.Monad.IO.Class (liftIO) import Linear (V3 (..)) import Foreign.Ptr gpPntToV3 :: Ptr GP.Pnt -> IO (V3 Double) gpPntToV3 :: Ptr Pnt -> IO (V3 Double) gpPntToV3 Ptr Pnt pnt = Double -> Double -> Double -> V3 Double forall a. a -> a -> a -> V3 a V3 (Double -> Double -> Double -> V3 Double) -> IO Double -> IO (Double -> Double -> V3 Double) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Ptr Pnt -> IO Double GP.Pnt.getX Ptr Pnt pnt IO (Double -> Double -> V3 Double) -> IO Double -> IO (Double -> V3 Double) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Ptr Pnt -> IO Double GP.Pnt.getY Ptr Pnt pnt IO (Double -> V3 Double) -> IO Double -> IO (V3 Double) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Ptr Pnt -> IO Double GP.Pnt.getZ Ptr Pnt pnt edgeEndpoints :: Ptr TopoDS.Edge -> IO (V3 Double, V3 Double) edgeEndpoints :: Ptr Edge -> IO (V3 Double, V3 Double) edgeEndpoints Ptr Edge e = (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 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 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 e 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)