module Waterfall.TwoD.Internal.Path2D
( Path2D (..)
, joinPaths
) where
import Data.Foldable (traverse_, toList)
import Data.Acquire
import Control.Monad ((<=<))
import Control.Monad.IO.Class (liftIO)
import qualified OpenCascade.TopoDS as TopoDS
import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire
import Foreign.Ptr
import Data.Semigroup (sconcat)
newtype Path2D = Path2D { Path2D -> Acquire (Ptr Wire)
runPath :: Acquire (Ptr TopoDS.Wire) }
joinPaths :: [Path2D] -> Path2D
joinPaths :: [Path2D] -> Path2D
joinPaths [Path2D]
paths = Acquire (Ptr Wire) -> Path2D
Path2D (Acquire (Ptr Wire) -> Path2D) -> Acquire (Ptr Wire) -> Path2D
forall a b. (a -> b) -> a -> b
$ do
Ptr MakeWire
builder <- Acquire (Ptr MakeWire)
MakeWire.new
(Path2D -> Acquire ()) -> [Path2D] -> Acquire ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (Ptr Wire -> IO ()) -> Ptr Wire -> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr MakeWire -> Ptr Wire -> IO ()
MakeWire.addWire Ptr MakeWire
builder (Ptr Wire -> Acquire ())
-> (Path2D -> Acquire (Ptr Wire)) -> Path2D -> Acquire ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Path2D -> Acquire (Ptr Wire)
runPath) [Path2D]
paths
Ptr MakeWire -> Acquire (Ptr Wire)
MakeWire.wire Ptr MakeWire
builder
instance Semigroup Path2D where
sconcat :: NonEmpty Path2D -> Path2D
sconcat = [Path2D] -> Path2D
joinPaths ([Path2D] -> Path2D)
-> (NonEmpty Path2D -> [Path2D]) -> NonEmpty Path2D -> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Path2D -> [Path2D]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
Path2D
a <> :: Path2D -> Path2D -> Path2D
<> Path2D
b = [Path2D] -> Path2D
joinPaths [Path2D
a, Path2D
b]
instance Monoid Path2D where
mempty :: Path2D
mempty = [Path2D] -> Path2D
joinPaths []
mconcat :: [Path2D] -> Path2D
mconcat = [Path2D] -> Path2D
joinPaths