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