module Waterfall.Internal.Edges
( edgeEndpoints
, edgeValue
, wireEndpoints
, allWireEndpoints
, allWires
, allEdges
, wireEdges
, wireTangentStart
, buildEdgeCurve3D
, reverseEdge
, reverseWire
, intersperseLines
, joinWires
, splitWires
, edgeToWire
) where

import qualified OpenCascade.TopoDS as TopoDS
import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape
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.TopExp.Explorer as Explorer 
import qualified OpenCascade.TopAbs.ShapeEnum as ShapeEnum
import qualified OpenCascade.TopTools.ShapeMapHasher as TopTools.ShapeMapHasher
import qualified OpenCascade.BRepBuilderAPI.MakeEdge as MakeEdge
import qualified OpenCascade.BRepLib as BRepLib
import OpenCascade.GeomAbs.Shape as GeomAbs.Shape
import Waterfall.Internal.FromOpenCascade (gpPntToV3, gpVecToV3)
import Data.Acquire
import Control.Monad.IO.Class (liftIO)
import Linear (V3 (..), distance, normalize, nearZero)
import Foreign.Ptr
import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire
import Control.Monad (when)
import Waterfall.Internal.ToOpenCascade (v3ToPnt)
import Data.Foldable (traverse_)
import OpenCascade.Inheritance (upcast, unsafeDowncast)

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)

edgeValue :: Ptr TopoDS.Edge -> Double -> IO (V3 Double)
edgeValue :: Ptr Edge -> Double -> IO (V3 Double)
edgeValue Ptr Edge
edge Double
v = (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
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
    let p' :: Double
p' = (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
v) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p2
    (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
p'

allWireEndpoints :: Ptr TopoDS.Wire -> IO [(V3 Double, V3 Double)]
allWireEndpoints :: Ptr Wire -> IO [(V3 Double, V3 Double)]
allWireEndpoints 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
    let runToEnd :: IO [(V3 Double, V3 Double)]
runToEnd = do
            Ptr Edge
edge <- Ptr WireExplorer -> IO (Ptr Edge)
WireExplorer.current Ptr WireExplorer
explorer
            (V3 Double, V3 Double)
points <- 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 ((V3 Double, V3 Double)
points(V3 Double, V3 Double)
-> [(V3 Double, V3 Double)] -> [(V3 Double, V3 Double)]
forall a. a -> [a] -> [a]
:) ([(V3 Double, V3 Double)] -> [(V3 Double, V3 Double)])
-> IO [(V3 Double, V3 Double)] -> IO [(V3 Double, V3 Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(V3 Double, V3 Double)]
runToEnd
                else [(V3 Double, V3 Double)] -> IO [(V3 Double, V3 Double)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(V3 Double, V3 Double)
points]
    IO [(V3 Double, V3 Double)]
runToEnd

allSubShapes :: ShapeEnum.ShapeEnum -> Ptr TopoDS.Shape -> Acquire [Ptr TopoDS.Shape]
allSubShapes :: ShapeEnum -> Ptr Shape -> Acquire [Ptr Shape]
allSubShapes ShapeEnum
t Ptr Shape
s = do 
    Ptr Explorer
explorer <- Ptr Shape -> ShapeEnum -> Acquire (Ptr Explorer)
Explorer.new Ptr Shape
s ShapeEnum
t
    let go :: t Int -> m [Ptr Shape]
go t Int
visited = do
            Bool
isMore <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ptr Explorer -> IO Bool
Explorer.more Ptr Explorer
explorer
            if Bool
isMore 
                then do
                    Ptr Shape
v <- IO (Ptr Shape) -> m (Ptr Shape)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Shape) -> m (Ptr Shape))
-> IO (Ptr Shape) -> m (Ptr Shape)
forall a b. (a -> b) -> a -> b
$ Ptr Explorer -> IO (Ptr Shape)
Explorer.value Ptr Explorer
explorer
                    Int
hash <- IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ptr Shape -> IO Int
TopTools.ShapeMapHasher.hash Ptr Shape
v
                    let add :: [Ptr Shape] -> [Ptr Shape]
add = if Int
hash Int -> t Int -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Int
visited then [Ptr Shape] -> [Ptr Shape]
forall a. a -> a
id else (Ptr Shape
vPtr Shape -> [Ptr Shape] -> [Ptr Shape]
forall a. a -> [a] -> [a]
:) 
                    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Explorer -> IO ()
Explorer.next Ptr Explorer
explorer
                    [Ptr Shape] -> [Ptr Shape]
add ([Ptr Shape] -> [Ptr Shape]) -> m [Ptr Shape] -> m [Ptr Shape]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Int -> m [Ptr Shape]
go t Int
visited
                else [Ptr Shape] -> m [Ptr Shape]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [Int] -> Acquire [Ptr Shape]
forall {m :: * -> *} {t :: * -> *}.
(MonadIO m, Foldable t) =>
t Int -> m [Ptr Shape]
go []

    
allSubShapesWithCopy :: ShapeEnum.ShapeEnum -> Ptr TopoDS.Shape -> Acquire [Ptr TopoDS.Shape]
allSubShapesWithCopy :: ShapeEnum -> Ptr Shape -> Acquire [Ptr Shape]
allSubShapesWithCopy ShapeEnum
t Ptr Shape
s = do 
    Ptr Explorer
explorer <- Ptr Shape -> ShapeEnum -> Acquire (Ptr Explorer)
Explorer.new Ptr Shape
s ShapeEnum
t
    let go :: t Int -> Acquire [Ptr Shape]
go t Int
visited = do
            Bool
isMore <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr Explorer -> IO Bool
Explorer.more Ptr Explorer
explorer
            if Bool
isMore 
                then do
                    Ptr Shape
v <- IO (Ptr Shape) -> Acquire (Ptr Shape)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Shape) -> Acquire (Ptr Shape))
-> IO (Ptr Shape) -> Acquire (Ptr Shape)
forall a b. (a -> b) -> a -> b
$ Ptr Explorer -> IO (Ptr Shape)
Explorer.value Ptr Explorer
explorer
                    Int
hash <- IO Int -> Acquire Int
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Acquire Int) -> IO Int -> Acquire Int
forall a b. (a -> b) -> a -> b
$ Ptr Shape -> IO Int
TopTools.ShapeMapHasher.hash Ptr Shape
v
                    [Ptr Shape] -> [Ptr Shape]
add <- if Int
hash Int -> t Int -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Int
visited 
                        then ([Ptr Shape] -> [Ptr Shape])
-> Acquire ([Ptr Shape] -> [Ptr Shape])
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Ptr Shape] -> [Ptr Shape]
forall a. a -> a
id 
                        else do
                            Ptr Shape
v' <- Ptr Shape -> Acquire (Ptr Shape)
TopoDS.Shape.copy Ptr Shape
v
                            ([Ptr Shape] -> [Ptr Shape])
-> Acquire ([Ptr Shape] -> [Ptr Shape])
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Shape
v'Ptr Shape -> [Ptr Shape] -> [Ptr Shape]
forall a. a -> [a] -> [a]
:) 
                    IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr Explorer -> IO ()
Explorer.next Ptr Explorer
explorer
                    [Ptr Shape] -> [Ptr Shape]
add ([Ptr Shape] -> [Ptr Shape])
-> Acquire [Ptr Shape] -> Acquire [Ptr Shape]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Int -> Acquire [Ptr Shape]
go t Int
visited
                else [Ptr Shape] -> Acquire [Ptr Shape]
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [Int] -> Acquire [Ptr Shape]
forall {t :: * -> *}. Foldable t => t Int -> Acquire [Ptr Shape]
go []


allEdges :: Ptr TopoDS.Shape -> Acquire [Ptr TopoDS.Edge]
allEdges :: Ptr Shape -> Acquire [Ptr Edge]
allEdges Ptr Shape
s = (Ptr Shape -> Acquire (Ptr Edge))
-> [Ptr Shape] -> Acquire [Ptr Edge]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> Acquire (Ptr Edge))
-> (Ptr Shape -> IO (Ptr Edge)) -> Ptr Shape -> Acquire (Ptr Edge)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> IO (Ptr Edge)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast) ([Ptr Shape] -> Acquire [Ptr Edge])
-> Acquire [Ptr Shape] -> Acquire [Ptr Edge]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ShapeEnum -> Ptr Shape -> Acquire [Ptr Shape]
allSubShapesWithCopy ShapeEnum
ShapeEnum.Edge Ptr Shape
s 

allWires :: Ptr TopoDS.Shape -> Acquire [Ptr TopoDS.Wire]
allWires :: Ptr Shape -> Acquire [Ptr Wire]
allWires Ptr Shape
s = (Ptr Shape -> Acquire (Ptr Wire))
-> [Ptr Shape] -> Acquire [Ptr Wire]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (IO (Ptr Wire) -> Acquire (Ptr Wire)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Wire) -> Acquire (Ptr Wire))
-> (Ptr Shape -> IO (Ptr Wire)) -> Ptr Shape -> Acquire (Ptr Wire)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> IO (Ptr Wire)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast) ([Ptr Shape] -> Acquire [Ptr Wire])
-> Acquire [Ptr Shape] -> Acquire [Ptr Wire]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ShapeEnum -> Ptr Shape -> Acquire [Ptr Shape]
allSubShapes ShapeEnum
ShapeEnum.Wire Ptr Shape
s 
    
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)

edgeTangentStart :: Ptr TopoDS.Edge -> IO (V3 Double)
edgeTangentStart :: Ptr Edge -> IO (V3 Double)
edgeTangentStart 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

edgeTangentEnd :: Ptr TopoDS.Edge -> IO (V3 Double)
edgeTangentEnd :: Ptr Edge -> IO (V3 Double)
edgeTangentEnd 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.curveParamLast (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

wireTangentStart :: Ptr TopoDS.Wire -> IO (V3 Double)
wireTangentStart :: Ptr Wire -> IO (V3 Double)
wireTangentStart 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)
edgeTangentStart Ptr Edge
v1

reverseEdge :: Ptr TopoDS.Edge -> Acquire (Ptr TopoDS.Edge)
reverseEdge :: Ptr Edge -> Acquire (Ptr Edge)
reverseEdge Ptr Edge
e = do
    Ptr (Handle Curve)
curve <- Ptr Edge -> Acquire (Ptr (Handle Curve))
BRep.Tool.curve Ptr Edge
e 
    Double
firstP <- IO Double -> Acquire Double
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Acquire Double) -> IO Double -> Acquire Double
forall a b. (a -> b) -> a -> b
$ Ptr Edge -> IO Double
BRep.Tool.curveParamFirst Ptr Edge
e
    Double
lastP <- IO Double -> Acquire Double
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Acquire Double) -> IO Double -> Acquire Double
forall a b. (a -> b) -> a -> b
$ Ptr Edge -> IO Double
BRep.Tool.curveParamLast Ptr Edge
e
    Double
firstP' <- IO Double -> Acquire Double
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Acquire Double) -> IO Double -> Acquire Double
forall a b. (a -> b) -> a -> b
$ Ptr (Handle Curve) -> Double -> IO Double
Geom.Curve.reversedParameter Ptr (Handle Curve)
curve Double
firstP
    Double
lastP' <- IO Double -> Acquire Double
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Acquire Double) -> IO Double -> Acquire Double
forall a b. (a -> b) -> a -> b
$ Ptr (Handle Curve) -> Double -> IO Double
Geom.Curve.reversedParameter Ptr (Handle Curve)
curve Double
lastP
    Ptr (Handle Curve)
curve' <- Ptr (Handle Curve) -> Acquire (Ptr (Handle Curve))
Geom.Curve.reversed Ptr (Handle Curve)
curve
    Ptr (Handle Curve) -> Double -> Double -> Acquire (Ptr Edge)
MakeEdge.fromCurveAndParameters Ptr (Handle Curve)
curve' Double
lastP' Double
firstP' 

wireEdges :: Ptr TopoDS.Wire -> Acquire [Ptr TopoDS.Edge]
wireEdges :: Ptr Wire -> Acquire [Ptr Edge]
wireEdges Ptr Wire
wire = do
    Ptr WireExplorer
explorer <- Ptr Wire -> Acquire (Ptr WireExplorer)
WireExplorer.fromWire Ptr Wire
wire
    let runToEnd :: Acquire [Ptr Edge]
runToEnd = do
            Ptr Edge
edge <- IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> Acquire (Ptr Edge))
-> IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO (Ptr Edge)
WireExplorer.current Ptr WireExplorer
explorer
            Ptr Edge
edge' <- (IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> Acquire (Ptr Edge))
-> (Ptr Shape -> IO (Ptr Edge)) -> Ptr Shape -> Acquire (Ptr Edge)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> IO (Ptr Edge)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast) (Ptr Shape -> Acquire (Ptr Edge))
-> Acquire (Ptr Shape) -> Acquire (Ptr Edge)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Shape -> Acquire (Ptr Shape)
TopoDS.Shape.copy (Ptr Edge -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Edge
edge)
            IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO ()
WireExplorer.next Ptr WireExplorer
explorer
            Bool
more <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO Bool
WireExplorer.more Ptr WireExplorer
explorer
            if Bool
more 
                then (Ptr Edge
edge' Ptr Edge -> [Ptr Edge] -> [Ptr Edge]
forall a. a -> [a] -> [a]
:) ([Ptr Edge] -> [Ptr Edge])
-> Acquire [Ptr Edge] -> Acquire [Ptr Edge]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Acquire [Ptr Edge]
runToEnd
                else [Ptr Edge] -> Acquire [Ptr Edge]
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Ptr Edge
edge']
    Acquire [Ptr Edge]
runToEnd

reverseWire :: Ptr TopoDS.Wire -> Acquire (Ptr TopoDS.Wire) 
reverseWire :: Ptr Wire -> Acquire (Ptr Wire)
reverseWire Ptr Wire
wire = do
    Ptr WireExplorer
explorer <- Ptr Wire -> Acquire (Ptr WireExplorer)
WireExplorer.fromWire Ptr Wire
wire
    Ptr MakeWire
makeWire <- Acquire (Ptr MakeWire)
MakeWire.new
    let runToEnd :: Acquire ()
runToEnd = do
            Ptr Edge
edge <- IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> Acquire (Ptr Edge))
-> IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO (Ptr Edge)
WireExplorer.current Ptr WireExplorer
explorer
            Ptr Edge
edge' <- Ptr Edge -> Acquire (Ptr Edge)
reverseEdge Ptr Edge
edge
            IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO ()
WireExplorer.next Ptr WireExplorer
explorer
            Bool
more <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO Bool
WireExplorer.more Ptr WireExplorer
explorer
            Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
more Acquire ()
runToEnd
            IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr MakeWire -> Ptr Edge -> IO ()
MakeWire.addEdge Ptr MakeWire
makeWire Ptr Edge
edge'
    Acquire ()
runToEnd
    Ptr MakeWire -> Acquire (Ptr Wire)
MakeWire.wire Ptr MakeWire
makeWire

line' :: V3 Double -> V3 Double -> Acquire (Ptr TopoDS.Wire)
line' :: V3 Double -> V3 Double -> Acquire (Ptr Wire)
line' V3 Double
s V3 Double
e = do
    Ptr MakeWire
builder <- Acquire (Ptr MakeWire)
MakeWire.new
    Ptr Pnt
pt1 <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
s
    Ptr Pnt
pt2 <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
e
    Ptr Edge
edge <- Ptr Pnt -> Ptr Pnt -> Acquire (Ptr Edge)
MakeEdge.fromPnts Ptr Pnt
pt1 Ptr Pnt
pt2
    IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr MakeWire -> Ptr Edge -> IO ()
MakeWire.addEdge Ptr MakeWire
builder Ptr Edge
edge
    Ptr MakeWire -> Acquire (Ptr Wire)
MakeWire.wire Ptr MakeWire
builder
    
intersperseLines :: [Ptr TopoDS.Wire] -> Acquire [Ptr TopoDS.Wire]
intersperseLines :: [Ptr Wire] -> Acquire [Ptr Wire]
intersperseLines [] = [Ptr Wire] -> Acquire [Ptr Wire]
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
intersperseLines [Ptr Wire
x] = [Ptr Wire] -> Acquire [Ptr Wire]
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Ptr Wire
x]
intersperseLines (Ptr Wire
a:Ptr Wire
b:[Ptr Wire]
xs) = do
    (V3 Double
_, V3 Double
ea) <- IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double))
-> IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double)
forall a b. (a -> b) -> a -> b
$ Ptr Wire -> IO (V3 Double, V3 Double)
wireEndpoints Ptr Wire
a
    (V3 Double
sb, V3 Double
_) <- IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double))
-> IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double)
forall a b. (a -> b) -> a -> b
$ Ptr Wire -> IO (V3 Double, V3 Double)
wireEndpoints Ptr Wire
b
    if V3 Double -> V3 Double -> Double
forall a. Floating a => V3 a -> V3 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
distance V3 Double
ea V3 Double
sb Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e-6
            then (Ptr Wire
a Ptr Wire -> [Ptr Wire] -> [Ptr Wire]
forall a. a -> [a] -> [a]
:) ([Ptr Wire] -> [Ptr Wire])
-> Acquire [Ptr Wire] -> Acquire [Ptr Wire]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ptr Wire] -> Acquire [Ptr Wire]
intersperseLines (Ptr Wire
bPtr Wire -> [Ptr Wire] -> [Ptr Wire]
forall a. a -> [a] -> [a]
:[Ptr Wire]
xs)
            else (Ptr Wire
a Ptr Wire -> [Ptr Wire] -> [Ptr Wire]
forall a. a -> [a] -> [a]
:) ([Ptr Wire] -> [Ptr Wire])
-> Acquire [Ptr Wire] -> Acquire [Ptr Wire]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Ptr Wire -> [Ptr Wire] -> [Ptr Wire])
-> Acquire (Ptr Wire) -> Acquire ([Ptr Wire] -> [Ptr Wire])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V3 Double -> V3 Double -> Acquire (Ptr Wire)
line' V3 Double
ea V3 Double
sb Acquire ([Ptr Wire] -> [Ptr Wire])
-> Acquire [Ptr Wire] -> Acquire [Ptr Wire]
forall a b. Acquire (a -> b) -> Acquire a -> Acquire b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Ptr Wire] -> Acquire [Ptr Wire]
intersperseLines (Ptr Wire
bPtr Wire -> [Ptr Wire] -> [Ptr Wire]
forall a. a -> [a] -> [a]
:[Ptr Wire]
xs))

joinWires :: [Ptr TopoDS.Wire] -> Acquire (Ptr TopoDS.Wire)
joinWires :: [Ptr Wire] -> Acquire (Ptr Wire)
joinWires [Ptr Wire]
wires = do
    Ptr MakeWire
builder <- Acquire (Ptr MakeWire)
MakeWire.new
    let addWire :: Ptr Wire -> Acquire ()
addWire Ptr Wire
wire = do 
            Ptr WireExplorer
explorer <- Ptr Wire -> Acquire (Ptr WireExplorer)
WireExplorer.fromWire Ptr Wire
wire
            let runToEnd :: Acquire ()
runToEnd = do
                    Ptr Edge
edge <- IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> Acquire (Ptr Edge))
-> IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO (Ptr Edge)
WireExplorer.current Ptr WireExplorer
explorer
                    IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr MakeWire -> Ptr Edge -> IO ()
MakeWire.addEdge Ptr MakeWire
builder Ptr Edge
edge
                    IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO ()
WireExplorer.next Ptr WireExplorer
explorer
                    Bool
more <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO Bool
WireExplorer.more Ptr WireExplorer
explorer
                    Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
more Acquire ()
runToEnd
            Acquire ()
runToEnd
    (Ptr Wire -> Acquire ()) -> [Ptr Wire] -> Acquire ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Ptr Wire -> Acquire ()
addWire ([Ptr Wire] -> Acquire ()) -> [Ptr Wire] -> Acquire ()
forall a b. (a -> b) -> a -> b
$ [Ptr Wire]
wires
    Ptr MakeWire -> Acquire (Ptr Wire)
MakeWire.wire Ptr MakeWire
builder

    
edgeToWire :: Ptr TopoDS.Edge -> Acquire (Ptr TopoDS.Wire)
edgeToWire :: Ptr Edge -> Acquire (Ptr Wire)
edgeToWire Ptr Edge
edge = do
    Ptr MakeWire
builder <- Acquire (Ptr MakeWire)
MakeWire.new
    IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr MakeWire -> Ptr Edge -> IO ()
MakeWire.addEdge Ptr MakeWire
builder Ptr Edge
edge
    Ptr MakeWire -> Acquire (Ptr Wire)
MakeWire.wire Ptr MakeWire
builder

splitWires :: Ptr TopoDS.Wire -> Acquire [Ptr TopoDS.Wire]
splitWires :: Ptr Wire -> Acquire [Ptr Wire]
splitWires Ptr Wire
wire = do
    Ptr WireExplorer
explorer <- Ptr Wire -> Acquire (Ptr WireExplorer)
WireExplorer.fromWire Ptr Wire
wire
    let makeSegment :: Acquire [Ptr Wire]
makeSegment = do
            Ptr MakeWire
builder <- Acquire (Ptr MakeWire)
MakeWire.new
            let addOneWire :: Maybe (V3 Double) -> IO ()
addOneWire Maybe (V3 Double)
lastDelta = do
                    Ptr Edge
edge <- IO (Ptr Edge) -> IO (Ptr Edge)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> IO (Ptr Edge)) -> IO (Ptr Edge) -> IO (Ptr Edge)
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO (Ptr Edge)
WireExplorer.current Ptr WireExplorer
explorer
                    V3 Double
s' <- V3 Double -> V3 Double
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize (V3 Double -> V3 Double) -> IO (V3 Double) -> IO (V3 Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Edge -> IO (V3 Double)
edgeTangentStart Ptr Edge
edge
                    V3 Double
e' <- V3 Double -> V3 Double
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize (V3 Double -> V3 Double) -> IO (V3 Double) -> IO (V3 Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Edge -> IO (V3 Double)
edgeTangentEnd Ptr Edge
edge
                    let startIsTangent :: Bool
startIsTangent = Bool -> (V3 Double -> Bool) -> Maybe (V3 Double) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (V3 Double -> Bool
forall a. Epsilon a => a -> Bool
nearZero (V3 Double -> Bool)
-> (V3 Double -> V3 Double) -> V3 Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3 Double
s' V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
-)) Maybe (V3 Double)
lastDelta
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
startIsTangent (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                            IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MakeWire -> Ptr Edge -> IO ()
MakeWire.addEdge Ptr MakeWire
builder Ptr Edge
edge
                            IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO ()
WireExplorer.next Ptr WireExplorer
explorer
                            Bool
more <- IO Bool -> IO Bool
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO Bool
WireExplorer.more Ptr WireExplorer
explorer
                            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
more (Maybe (V3 Double) -> IO ()
addOneWire (V3 Double -> Maybe (V3 Double)
forall a. a -> Maybe a
Just V3 Double
e'))
            IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Maybe (V3 Double) -> IO ()
addOneWire Maybe (V3 Double)
forall a. Maybe a
Nothing
            Ptr Wire
thisWire <- Ptr MakeWire -> Acquire (Ptr Wire)
MakeWire.wire Ptr MakeWire
builder
            Bool
more <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr WireExplorer -> IO Bool
WireExplorer.more Ptr WireExplorer
explorer
            [Ptr Wire]
rest <- if Bool
more
                then Acquire [Ptr Wire]
makeSegment 
                else [Ptr Wire] -> Acquire [Ptr Wire]
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            [Ptr Wire] -> Acquire [Ptr Wire]
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ptr Wire] -> Acquire [Ptr Wire])
-> [Ptr Wire] -> Acquire [Ptr Wire]
forall a b. (a -> b) -> a -> b
$ Ptr Wire
thisWire Ptr Wire -> [Ptr Wire] -> [Ptr Wire]
forall a. a -> [a] -> [a]
: [Ptr Wire]
rest 
    Acquire [Ptr Wire]
makeSegment

buildEdgeCurve3D :: Ptr TopoDS.Edge -> Acquire (Ptr TopoDS.Edge)
buildEdgeCurve3D :: Ptr Edge -> Acquire (Ptr Edge)
buildEdgeCurve3D Ptr Edge
edge = do 
    Ptr Edge
edge' <- (IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> Acquire (Ptr Edge))
-> (Ptr Shape -> IO (Ptr Edge)) -> Ptr Shape -> Acquire (Ptr Edge)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> IO (Ptr Edge)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast) (Ptr Shape -> Acquire (Ptr Edge))
-> Acquire (Ptr Shape) -> Acquire (Ptr Edge)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Shape -> Acquire (Ptr Shape)
TopoDS.Shape.copy (Ptr Edge -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Edge
edge)
    Bool
_ <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr Edge -> Double -> Shape -> Int -> Int -> IO Bool
BRepLib.buildCurve3d Ptr Edge
edge' Double
1e-5 Shape
GeomAbs.Shape.C1 Int
14 Int
0
    Ptr Edge -> Acquire (Ptr Edge)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Edge
edge'