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
    curve <- Ptr Edge -> Acquire (Ptr (Handle Curve))
BRep.Tool.curve Ptr Edge
edge
    p1 <- liftIO . BRep.Tool.curveParamFirst $ edge
    p2 <- liftIO . BRep.Tool.curveParamLast $ edge
    s <- (liftIO . gpPntToV3) =<< Geom.Curve.value curve p1
    e <- (liftIO . gpPntToV3) =<< Geom.Curve.value curve p2
    return (s, 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
    v1 <- Ptr WireExplorer -> IO (Ptr Edge)
WireExplorer.current Ptr WireExplorer
explorer
    (s, _) <- edgeEndpoints v1
    let runToEnd = do
            edge <- Ptr WireExplorer -> IO (Ptr Edge)
WireExplorer.current Ptr WireExplorer
explorer
            (_s, e') <- edgeEndpoints edge
            WireExplorer.next explorer
            more <- WireExplorer.more explorer
            if more 
                then runToEnd
                else pure e'
    e <- runToEnd
    return (s, 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
    curve <- Ptr Edge -> Acquire (Ptr (Handle Curve))
BRep.Tool.curve Ptr Edge
e
    p1 <- liftIO . BRep.Tool.curveParamFirst $ e
    liftIO . gpVecToV3 =<< Geom.Curve.dn curve p1 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
    v1 <- Ptr WireExplorer -> IO (Ptr Edge)
WireExplorer.current Ptr WireExplorer
explorer
    edgeTangent v1