packages feed

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 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