waterfall-cad 0.5.1.1 → 0.6.0.0

raw patch · 13 files changed

+295/−61 lines, 13 filesdep ~opencascade-hsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: opencascade-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• src/Waterfall.hs +3/−0
• src/Waterfall/Booleans.hs +65/−7
• src/Waterfall/Booleans/Operators.hs +7/−8
• src/Waterfall/Fillet.hs +42/−5
• src/Waterfall/Internal/Solid.hs +34/−33
• src/Waterfall/Revolution.hs +1/−1
• src/Waterfall/Solids.hs +2/−2
• src/Waterfall/Sweep.hs +1/−1
• src/Waterfall/TwoD/Booleans.hs +13/−0
• src/Waterfall/TwoD/Internal/Shape.hs +99/−1
• src/Waterfall/TwoD/Shape.hs +8/−1
• waterfall-cad.cabal +3/−2

@@ -9,6 +9,23 @@  ## Unreleased +## 0.6.0.0++### Added++- Added `Boolean` typeclass providing boolean operations on both 2D and 3D objects+  - `union`, `intersection`, `difference`, `unions`, `intersections` and operators `(~/\~)`, `(~\/~)`, `(~-~)` are now polymorphic+- Added 2D boolean operations: `union2D`, `difference2D`, `intersection2D`, `unions2D`, `intersections2D`+- Added `emptyShape` for 2D shapes+- Added `Waterfall.TwoD.Booleans` module+- Added `chamfer`, `conditionalChamfer` and `indexedConditionalChamfer` to `Waterfall.Fillet`++### Changed++- Renamed `union` to `union3D`, `difference` to `difference3D`, `intersection` to `intersection3D` for 3D operations+- Renamed `unions` to `unions3D`, `intersections` to `intersections3D` for 3D batch operations  +- Renamed `nowhere3D` to `emptySolid`+ ## 0.5.1.1  ### Added 

@@ -16,6 +16,8 @@ -- [Constructive Solid Geometry](https://en.wikipedia.org/wiki/Constructive_solid_geometry). , module Waterfall.Booleans , module Waterfall.Booleans.Operators+-- | 2D `Shape`'s can also be combined with CSG operations.+, module Waterfall.TwoD.Booleans -- | Once you've generated a `Solid`,  -- the functions in `Waterfall.IO` can be used to save it. -- @@ -56,6 +58,7 @@  import Waterfall.Booleans import Waterfall.Booleans.Operators+import Waterfall.TwoD.Booleans import Waterfall.BoundingBox.AxisAligned import Waterfall.BoundingBox.Oriented import Waterfall.Diagram

@@ -1,13 +1,71 @@ {-|-[Constructive Solid Geometry \(CSG\)](https://en.wikipedia.org/wiki/Constructive_solid_geometry) operations on `Solid`.+[Constructive Solid Geometry \(CSG\)](https://en.wikipedia.org/wiki/Constructive_solid_geometry) operations on `Solid`, and `Shape`. -} module Waterfall.Booleans-( union-, difference-, intersection+( union3D+, difference3D+, intersection3D , complement-, unions-, intersections+, unions3D+, intersections3D+, Boolean(..) ) where -import Waterfall.Internal.Solid(union, unions, difference, intersection, intersections, complement)+import Waterfall.Internal.Solid(union3D, unions3D, difference3D, intersection3D, intersections3D, complement)+import qualified Waterfall.Solids as Solids+import qualified Waterfall.TwoD.Internal.Shape as Shape+import Waterfall.TwoD.Internal.Shape (union2D, difference2D, intersection2D, unions2D, intersections2D)++-- | Boolean Algebras, with an "empty" value.+class Boolean a where+    -- | Take the union of two objects+    -- +    -- The region occupied by either one of them.+    union :: a -> a -> a+    +    -- | Take the difference of two objects+    -- +    -- The region occupied by the first, but not the second.+    difference :: a -> a -> a+    +    -- | Take the intersection of two objects+    --+    -- The region occupied by both of them.+    intersection :: a -> a -> a+    +    -- | The empty object (identity for union, annihilator for intersection)+    --+    -- Represents a region of space containing no volume or area.+    --+    -- For union: @empty `union` x = x `union` empty = x@+    -- For intersection: @empty `intersection` x = x `intersection` empty = empty@+    empty :: a+    +    -- | Take the union of a list of objects+    --+    -- May be more performant than chaining multiple applications of `union`.+    unions :: [a] -> a+    unions = foldr union empty+    +    -- | Take the intersection of a list of objects+    --+    -- May be more performant than chaining multiple applications of `intersection`.+    intersections :: [a] -> a+    intersections [] = empty+    intersections xs = foldr1 intersection xs++instance Boolean Solids.Solid where+    union = union3D+    difference = difference3D+    intersection = intersection3D+    empty = Solids.emptySolid+    unions = unions3D+    intersections = intersections3D++instance Boolean Shape.Shape where+    union = union2D+    difference = difference2D+    intersection = intersection2D+    empty = Shape.emptyShape+    unions = unions2D+    intersections = intersections2D

@@ -2,17 +2,16 @@ ((~/\~), (~\/~), (~-~) )where  -import Waterfall.Booleans-import Waterfall.Solids (Solid)+import Waterfall.Booleans (Boolean(..)) --- | Infix version of `intersection`-(~/\~) :: Solid -> Solid -> Solid+-- | Infix version of `intersection` (works for both 2D and 3D objects)+(~/\~) :: Boolean a => a -> a -> a (~/\~) = intersection --- | Infix version of `union`-(~\/~) :: Solid -> Solid -> Solid+-- | Infix version of `union` (works for both 2D and 3D objects)+(~\/~) :: Boolean a => a -> a -> a (~\/~) = union --- | Infix version of `difference`-(~-~) :: Solid -> Solid -> Solid+-- | Infix version of `difference` (works for both 2D and 3D objects)+(~-~) :: Boolean a => a -> a -> a (~-~) = difference

@@ -2,24 +2,28 @@ ( roundFillet , roundConditionalFillet , roundIndexedConditionalFillet+, chamfer+, conditionalChamfer+, indexedConditionalChamfer ) where  import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire) import Waterfall.Internal.Edges (edgeEndpoints) import qualified OpenCascade.BRepFilletAPI.MakeFillet as MakeFillet+import qualified OpenCascade.BRepFilletAPI.MakeChamfer as MakeChamfer import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape 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.TopoDS.Types as TopoDS import Foreign.Ptr (Ptr) import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import OpenCascade.Inheritance (upcast, unsafeDowncast) import Linear.V3 (V3 (..)) --addEdgesToMakeFillet :: (Integer -> (V3 Double, V3 Double) -> Maybe Double) -> Ptr MakeFillet.MakeFillet -> Ptr Explorer.Explorer -> IO ()-addEdgesToMakeFillet radiusFn builder explorer = go [] 0+addEdges :: (Integer -> (V3 Double, V3 Double) -> Maybe Double) -> (Double -> Ptr TopoDS.Edge -> IO ()) -> Ptr Explorer.Explorer -> IO ()+addEdges radiusFn action explorer = go [] 0     where go visited i = do             isMore <- Explorer.more explorer             when isMore $ do@@ -32,7 +36,7 @@                     else do                         endpoints <- edgeEndpoints v                         case radiusFn i endpoints of -                            Just r | r > 0 -> MakeFillet.addEdgeWithRadius builder r v+                            Just r | r > 0 -> action r v                             _ -> pure ()                         Explorer.next explorer                         go (hash:visited) (i + 1) @@ -52,7 +56,7 @@     builder <- MakeFillet.fromShape s      explorer <- Explorer.new s ShapeEnum.Edge-    liftIO $ addEdgesToMakeFillet radiusFunction builder explorer+    liftIO $ addEdges radiusFunction (MakeFillet.addEdgeWithRadius builder) explorer      MakeShape.shape (upcast builder) @@ -67,3 +71,36 @@ -- Because this is applied to both internal (concave) and external (convex) edges, it may technically produce both Rounds and Fillets roundFillet :: Double -> Solid -> Solid roundFillet r = roundConditionalFillet (const . pure $ r)+++-- | Add chamfers of the given size to each edge of a solid, conditional on the endpoints of the edge, and the index of the edge.+-- +-- This can be used to selectively chamfer a `Solid`.+--+-- In general, relying on the edge index is inelegant,+-- however, if you consider a Solid with a semicircular face, +-- there's no way to select either the curved or the flat edge of the semicircle based on just the endpoints.+--+-- Being able to selectively chamfer based on edge index is an \"easy\" way to chamfer these shapes. +indexedConditionalChamfer :: (Integer -> (V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid+indexedConditionalChamfer radiusFunction solid = solidFromAcquire $ do+    s <- acquireSolid solid+    builder <- MakeChamfer.fromShape s++    explorer <- Explorer.new s ShapeEnum.Edge+    liftIO $ addEdges radiusFunction (MakeChamfer.addEdgeWithDistance builder) explorer++    MakeShape.shape (upcast builder)++-- | Add chamfers with the given size to each edge of a solid, conditional on the endpoints of the edge.+-- +-- This can be used to selectively chamfer a `Solid`.+conditionalChamfer :: ((V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid+conditionalChamfer f = indexedConditionalChamfer (const f)++-- | Add a round with a given radius to every edge of a solid+--+-- This is applied to both internal (concave) and external (convex) edges+chamfer :: Double -> Solid -> Solid+chamfer d = conditionalChamfer (const . pure $ d)+

@@ -4,12 +4,12 @@ ( Solid (..) , acquireSolid , solidFromAcquire-, union-, difference-, intersection-, unions-, intersections-, nowhere+, union3D+, difference3D+, intersection3D+, unions3D+, intersections3D+, emptySolid , complement , debug ) where@@ -80,7 +80,7 @@ {-- -- TODO: this does not work, need to fix everywhere :: Solid-everywhere = complement $ nowhere+everywhere = complement $ emptySolid --}  -- | Invert a Solid, equivalent to `not` in boolean algebra.@@ -88,15 +88,15 @@ -- The complement of a solid represents the solid with the same surface, -- but where the opposite side of that surface is the \"inside\" of the solid. ----- Be warned that @complement nowhere@ does not appear to work correctly.+-- Be warned that @complement emptySolid@ does not appear to work correctly. complement :: Solid -> Solid complement (Solid ptr) = Solid . unsafeFromAcquire $ TopoDS.Shape.complemented =<< toAcquire ptr  -- | An empty solid ----- Be warned that @complement nowhere@ does not appear to work correctly.-nowhere :: Solid -nowhere =  Solid . unsafeFromAcquire $ upcast <$> (MakeSolid.solid =<< MakeSolid.new)+-- Be warned that @complement emptySolid@ does not appear to work correctly.+emptySolid :: Solid +emptySolid =  Solid . unsafeFromAcquire $ upcast <$> (MakeSolid.solid =<< MakeSolid.new)  -- defining the boolean CSG operators here, rather than in Waterfall.Booleans  -- means that we can use them in typeclass instances without resorting to orphans@@ -110,12 +110,12 @@ -- | Take the sum of two solids -- -- The region occupied by either one of them.-union :: Solid -> Solid -> Solid-union = toBoolean Fuse.fuse+union3D :: Solid -> Solid -> Solid+union3D = toBoolean Fuse.fuse   toBooleans :: BOPAlgo.Operation.Operation -> [Solid] -> Solid-toBooleans _ [] = nowhere+toBooleans _ [] = emptySolid toBooleans _ [x] = x toBooleans op (h:solids) = Solid . unsafeFromAcquire $ do     firstPtr <- toAcquire . rawSolid $ h@@ -132,47 +132,48 @@  -- | Take the sum of a list of solids  -- --- May be more performant than chaining multiple applications of `union`-unions :: [Solid] -> Solid-unions = toBooleans BOPAlgo.Operation.Fuse+-- May be more performant than chaining multiple applications of `union3D`+unions3D :: [Solid] -> Solid+unions3D = toBooleans BOPAlgo.Operation.Fuse  -- | Take the difference of two solids --  -- The region occupied by the first, but not the second.-difference :: Solid -> Solid -> Solid-difference = toBoolean Cut.cut+difference3D :: Solid -> Solid -> Solid+difference3D = toBoolean Cut.cut  -- | Take the intersection of two solids  -- -- The region occupied by both of them.-intersection :: Solid -> Solid -> Solid-intersection = toBoolean Common.common+intersection3D :: Solid -> Solid -> Solid+intersection3D = toBoolean Common.common   -- | Take the intersection of a list of solids  -- --- May be more performant than chaining multiple applications of `intersection`-intersections :: [Solid] -> Solid-intersections = toBooleans BOPAlgo.Operation.Common+-- May be more performant than chaining multiple applications of `intersection3D`+intersections3D :: [Solid] -> Solid+intersections3D = toBooleans BOPAlgo.Operation.Common --- | While `Solid` could form a Semigroup via either `union` or `intersection`.--- the default Semigroup is from `union`.+-- | While `Solid` could form a Semigroup via either `union3D` or `intersection3D`.+-- the default Semigroup is from `union3D`. ----- The Semigroup from `intersection` can be obtained using `Meet` from the lattices package.+-- The Semigroup from `intersection3D` can be obtained using `Meet` from the lattices package. instance Semigroup Solid where     (<>) :: Solid -> Solid -> Solid-    (<>) = union+    (<>) = union3D  instance Monoid Solid where-    mempty = nowhere-    mconcat = unions+    mempty = emptySolid+    mconcat = unions3D  instance Lattice Solid where -    (/\) = intersection-    (\/) = union+    (/\) = intersection3D+    (\/) = union3D  instance BoundedJoinSemiLattice Solid where-    bottom = nowhere+    bottom = emptySolid+ {-- -- TODO: because everywhere doesn't work correctly -- using the BoundedMeetSemiLattice instance

@@ -31,4 +31,4 @@         solidBuilder <- MakeSolid.new         liftIO $ MakeSolid.add solidBuilder =<< unsafeDowncast shell         MakeShape.shape (upcast solidBuilder)-revolution _ = Solids.nowhere+revolution _ = Solids.emptySolid

@@ -1,6 +1,6 @@ module Waterfall.Solids  ( Solid-, nowhere+, emptySolid , unitCube , centeredCube , box@@ -15,7 +15,7 @@ ) where  -import Waterfall.Internal.Solid (Solid (..), solidFromAcquire, acquireSolid, nowhere)+import Waterfall.Internal.Solid (Solid (..), solidFromAcquire, acquireSolid, emptySolid) import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire) import Waterfall.TwoD.Internal.Shape (rawShape) import Waterfall.Internal.FromOpenCascade (gpPntToV3)

@@ -43,4 +43,4 @@     adjustedFace <- positionFace start =<< rotateFace tangent shape     builder <- MakePipe.fromWireAndShape path adjustedFace     MakeShape.shape (upcast builder)-sweep _ _ = Solids.nowhere+sweep _ _ = Solids.emptySolid

@@ -0,0 +1,13 @@+{-|+[Boolean Operations](https://en.wikipedia.org/wiki/Boolean_operations_on_polygons) operations on `Shape`.+-}+module Waterfall.TwoD.Booleans+( union2D+, difference2D+, intersection2D+, unions2D+, intersections2D+, emptyShape+) where++import Waterfall.TwoD.Internal.Shape (union2D, unions2D, difference2D, intersection2D, intersections2D, emptyShape)

@@ -1,9 +1,32 @@+{-# OPTIONS_HADDOCK not-home #-} module Waterfall.TwoD.Internal.Shape-(Shape(..)+( Shape (..)+, acquireShape+, shapeFromAcquire+, union2D+, difference2D+, intersection2D+, unions2D+, intersections2D+, emptyShape ) where  import qualified OpenCascade.TopoDS as TopoDS import Foreign.Ptr+import Data.Acquire (Acquire)+import Algebra.Lattice+import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)+import qualified OpenCascade.BRepAlgoAPI.Fuse as Fuse+import qualified OpenCascade.BRepAlgoAPI.Cut as Cut+import qualified OpenCascade.BRepAlgoAPI.Common as Common+import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape+import qualified OpenCascade.BRepBuilderAPI.MakeFace as MakeFace+import qualified OpenCascade.BOPAlgo.Operation as BOPAlgo.Operation+import qualified OpenCascade.BOPAlgo.BOP as BOPAlgo.BOP+import qualified OpenCascade.BOPAlgo.Builder as BOPAlgo.Builder+import OpenCascade.Inheritance (upcast)+import Control.Monad.IO.Class (liftIO)+import Data.Foldable (traverse_)  -- | A Region in 2D Space  -- @@ -17,3 +40,78 @@ -- which does not lie on this plane (without using Internal functions). -- Or which is not either a `TopoDS.Face`, or a composite of faces. newtype Shape = Shape { rawShape :: Ptr TopoDS.Shape }++acquireShape :: Shape -> Acquire (Ptr TopoDS.Shape)+acquireShape (Shape ptr) = toAcquire ptr++shapeFromAcquire :: Acquire (Ptr TopoDS.Shape) -> Shape+shapeFromAcquire = Shape . unsafeFromAcquire++toBoolean2D :: (Ptr TopoDS.Shape.Shape -> Ptr TopoDS.Shape.Shape -> Acquire (Ptr TopoDS.Shape.Shape)) -> Shape -> Shape -> Shape+toBoolean2D f (Shape ptrA) (Shape ptrB) = Shape . unsafeFromAcquire $ do+    a <- toAcquire ptrA+    b <- toAcquire ptrB+    f a b++-- | Take the union of two 2D shapes.+-- The region occupied by either one of them+union2D :: Shape -> Shape -> Shape+union2D = toBoolean2D Fuse.fuse++-- | Take the difference of two 2D shapes.+-- The region occupied by the first, but not the second+difference2D :: Shape -> Shape -> Shape+difference2D = toBoolean2D Cut.cut++-- | Take the intersection of two 2D shapes.+-- The region occupied by both of them+intersection2D :: Shape -> Shape -> Shape+intersection2D = toBoolean2D Common.common++toBooleans2D :: BOPAlgo.Operation.Operation -> [Shape] -> Shape+toBooleans2D _ [] = emptyShape+toBooleans2D _ [x] = x+toBooleans2D op (h:shapes) = Shape . unsafeFromAcquire $ do+    firstPtr <- toAcquire . rawShape $ h+    ptrs <- traverse (toAcquire . rawShape) shapes+    bop <- BOPAlgo.BOP.new+    let builder = upcast bop+    liftIO $ do+        BOPAlgo.BOP.setOperation bop op+        BOPAlgo.Builder.addArgument builder firstPtr+        traverse_ (BOPAlgo.BOP.addTool bop) ptrs+        BOPAlgo.Builder.setRunParallel builder True+        BOPAlgo.Builder.perform builder+    BOPAlgo.Builder.shape builder++-- | Take the union of a list of 2D shapes+-- May be more performant than chaining multiple applications of `union2D`+unions2D :: [Shape] -> Shape+unions2D = toBooleans2D BOPAlgo.Operation.Fuse++-- | Take the intersection of a list of 2D shapes+-- May be more performant than chaining multiple applications of `intersection2D`+intersections2D :: [Shape] -> Shape+intersections2D = toBooleans2D BOPAlgo.Operation.Common++-- | An empty 2D shape+emptyShape :: Shape+emptyShape = Shape . unsafeFromAcquire $ +    upcast <$> (MakeFace.face =<< MakeFace.new)++-- defining these boolean operators here, rather than in Waterfall.TwoD.Booleans +-- means that we can use them in typeclass instances without resorting to orphans++instance Semigroup Shape where+    (<>) = union2D++instance Monoid Shape where+    mempty = emptyShape+    mconcat = unions2D++instance Lattice Shape where +    (/\) = intersection2D+    (\/) = union2D++instance BoundedJoinSemiLattice Shape where+    bottom = emptyShape

@@ -6,9 +6,16 @@ , unitSquare , centeredSquare , unitPolygon+-- * Boolean operations+, union2D+, difference2D+, intersection2D+, unions2D+, intersections2D+, emptyShape ) where -import Waterfall.TwoD.Internal.Shape (Shape (..))+import Waterfall.TwoD.Internal.Shape (Shape (..), union2D, difference2D, intersection2D, unions2D, intersections2D, emptyShape) import Waterfall.TwoD.Internal.Path2D (Path2D (..)) import Waterfall.TwoD.Transforms (translate2D, rotate2D) import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           waterfall-cad-version:        0.5.1.1+version:        0.6.0.0 synopsis:       Declarative CAD/Solid Modeling Library description:    Please see the README on GitHub at <https://github.com/joe-warren/opencascade-hs#readme> category:       Graphics@@ -53,6 +53,7 @@       Waterfall.Solids       Waterfall.Sweep       Waterfall.Transforms+      Waterfall.TwoD.Booleans       Waterfall.TwoD.Internal.Path2D       Waterfall.TwoD.Internal.Shape       Waterfall.TwoD.Path2D@@ -70,7 +71,7 @@     , lattices >=2.0 && <3     , lens ==5.*     , linear >=1.21 && <2-    , opencascade-hs >=0.5.1.1 && <0.6+    , opencascade-hs >=0.6.0.0 && <0.7     , primitive >=0.7 && <0.10     , resourcet >=1.2 && <1.4   default-language: Haskell2010