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)