module Waterfall.Internal.Edges ( gpPntToV3 , 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 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 import qualified OpenCascade.GP.Vec as GP.Vec 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 gpVecToV3 :: Ptr GP.Vec -> IO (V3 Double) gpVecToV3 :: Ptr Vec -> IO (V3 Double) gpVecToV3 Ptr Vec vec = 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 Vec -> IO Double GP.Vec.getX Ptr Vec vec 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 Vec -> IO Double GP.Vec.getY Ptr Vec vec 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 Vec -> IO Double GP.Vec.getZ Ptr Vec vec 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