waterfall-cad 0.6.3.1 → 0.6.3.2
raw patch · 5 files changed
+50/−10 lines, 5 filesdep ~opencascade-hsPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependency ranges changed: opencascade-hs
API changes (from Hackage documentation)
+ Waterfall.Internal.Finalizers: unsafeFromAcquireTWithCatch :: Traversable t => Acquire (t a) -> Either WaterfallError (t a)
+ Waterfall.Internal.Solid: solidFromAcquireTWithCatch :: Traversable t => Acquire (t (Ptr Shape)) -> Either WaterfallError (t Solid)
Files
- CHANGELOG.md +4/−0
- src/Waterfall/Internal/Finalizers.hs +7/−0
- src/Waterfall/Internal/Solid.hs +5/−1
- src/Waterfall/Offset.hs +32/−7
- waterfall-cad.cabal +2/−2
CHANGELOG.md view
@@ -8,6 +8,10 @@ ## Unreleased +## 0.6.3.2++- Fix an issue when the `offset` functions were applied to `Solid`s with multiple separate parts ("Compounds" in OpenCascade terms)+ ## 0.6.3.1 - Fix potential segfault in `shapePaths`
src/Waterfall/Internal/Finalizers.hs view
@@ -12,6 +12,7 @@ ( unsafeFromAcquire , unsafeFromAcquireWithCatch , unsafeFromAcquireT+, unsafeFromAcquireTWithCatch , fromAcquire , fromAcquireT , toAcquire@@ -80,6 +81,12 @@ {-# NOINLINE unsafeFromAcquireT #-} unsafeFromAcquireT :: (Traversable t) => Acquire (t a) -> t a unsafeFromAcquireT = unsafePerformIO . fromAcquireT+++-- | Version of `unsafeFromAcquireWithCatch` which registers the finalizer on the _value_ in a container +{-# NOINLINE unsafeFromAcquireTWithCatch #-}+unsafeFromAcquireTWithCatch :: (Traversable t) => Acquire (t a) -> Either WaterfallError (t a)+unsafeFromAcquireTWithCatch = left WaterfallError . unsafePerformIO . try . fromAcquireT -- | Add a pure value (which may or may not have been generated by `unsafeFromAcquire`) back into the Acquire monad. -- Using this action _should_ prevent the underlying value from going out of GC scope untill the resource is freed.
src/Waterfall/Internal/Solid.hs view
@@ -5,6 +5,7 @@ , acquireSolid , solidFromAcquire , solidFromAcquireWithCatch+, solidFromAcquireTWithCatch , union3D , difference3D , intersection3D@@ -29,7 +30,7 @@ import qualified OpenCascade.BOPAlgo.BOP as BOPAlgo.BOP import qualified OpenCascade.BOPAlgo.Builder as BOPAlgo.Builder import OpenCascade.Inheritance (upcast)-import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire, unsafeFromAcquireWithCatch)+import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire, unsafeFromAcquireWithCatch, unsafeFromAcquireTWithCatch) import qualified OpenCascade.BOPAlgo.Builder as BOPAlgo import Data.Foldable (traverse_) import Waterfall.Error (WaterfallError)@@ -54,6 +55,9 @@ solidFromAcquireWithCatch :: Acquire (Ptr TopoDS.Shape.Shape) -> Either WaterfallError Solid solidFromAcquireWithCatch = fmap Solid . unsafeFromAcquireWithCatch++solidFromAcquireTWithCatch :: Traversable t => Acquire (t (Ptr TopoDS.Shape.Shape)) -> Either WaterfallError (t Solid)+solidFromAcquireTWithCatch = fmap (fmap Solid) . unsafeFromAcquireTWithCatch -- | print debug information about a Solid when it's evaluated -- exposes the properties of the underlying OpenCacade.TopoDS.Shape
src/Waterfall/Offset.hs view
@@ -6,7 +6,7 @@ , tryOffsetWithTolerance ) where -import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquireWithCatch)+import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquireWithCatch, solidFromAcquireTWithCatch) import qualified OpenCascade.BRepOffsetAPI.MakeOffsetShape as MakeOffsetShape import Control.Monad.IO.Class (liftIO) import OpenCascade.Inheritance (SubTypeOf(upcast), unsafeDowncast)@@ -15,6 +15,7 @@ import qualified OpenCascade.GeomAbs.JoinType as GeomAbs.JoinType import qualified OpenCascade.BRepBuilderAPI.MakeSolid as MakeSolid import qualified OpenCascade.TopoDS.Types as TopoDS+import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape import qualified OpenCascade.TopExp.Explorer as TopExp.Explorer import qualified OpenCascade.TopAbs.ShapeEnum as TopAbs.ShapeEnum import Control.Monad (when)@@ -38,6 +39,30 @@ go upcast <$> MakeSolid.solid makeSolid +getCompoundAsSolids :: Ptr TopoDS.Shape -> Acquire [Ptr TopoDS.Shape]+getCompoundAsSolids s = do+ explorer <- TopExp.Explorer.new s TopAbs.ShapeEnum.Solid+ let go = do+ isMore <- liftIO $ TopExp.Explorer.more explorer+ if not isMore+ then pure []+ else do+ solid <- TopoDS.Shape.copy =<< liftIO (TopExp.Explorer.value explorer)+ liftIO $ TopExp.Explorer.next explorer+ (solid :) <$> go+ go++offsetOneWithTolerance :: + Double + -> Double + -> Ptr TopoDS.Shape+ -> Acquire (Ptr TopoDS.Shape)+offsetOneWithTolerance tolerance value s = do+ builder <- MakeOffsetShape.new+ liftIO $ MakeOffsetShape.performByJoin builder s value tolerance Mode.Skin False False GeomAbs.JoinType.Arc False + shell <- MakeShape.shape (upcast builder)+ combineShellsToSolid shell+ -- | Version of `offsetWithTolerance` that returns an error on failure tryOffsetWithTolerance :: Double @@ -46,12 +71,12 @@ -> Either WaterfallError Solid tryOffsetWithTolerance tolerance value solid | nearZero value = Right solid- | otherwise = solidFromAcquireWithCatch $ do- builder <- MakeOffsetShape.new- s <- acquireSolid solid - liftIO $ MakeOffsetShape.performByJoin builder s value tolerance Mode.Skin False False GeomAbs.JoinType.Arc False - shell <- MakeShape.shape (upcast builder)- combineShellsToSolid shell+ | otherwise = + fmap mconcat + . solidFromAcquireTWithCatch + $ traverse (offsetOneWithTolerance tolerance value) + =<< getCompoundAsSolids + =<< acquireSolid solid offsetWithTolerance :: Double -- ^ Tolerance, this can be relatively small
waterfall-cad.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: waterfall-cad-version: 0.6.3.1+version: 0.6.3.2 synopsis: Declarative CAD/Solid Modeling Library description: Please see the README on GitHub at <https://github.com/joe-warren/opencascade-hs#readme> category: Graphics@@ -73,7 +73,7 @@ , lattices >=2.0 && <3 , lens ==5.* , linear >=1.21 && <2- , opencascade-hs >=0.6.3.1 && <0.7+ , opencascade-hs >=0.6.3.2 && <0.7 , primitive >=0.7 && <0.10 , resourcet >=1.2 && <1.4 default-language: Haskell2010