diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/src/Waterfall.hs b/src/Waterfall.hs --- a/src/Waterfall.hs +++ b/src/Waterfall.hs @@ -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 diff --git a/src/Waterfall/Booleans.hs b/src/Waterfall/Booleans.hs --- a/src/Waterfall/Booleans.hs +++ b/src/Waterfall/Booleans.hs @@ -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 diff --git a/src/Waterfall/Booleans/Operators.hs b/src/Waterfall/Booleans/Operators.hs --- a/src/Waterfall/Booleans/Operators.hs +++ b/src/Waterfall/Booleans/Operators.hs @@ -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 diff --git a/src/Waterfall/Fillet.hs b/src/Waterfall/Fillet.hs --- a/src/Waterfall/Fillet.hs +++ b/src/Waterfall/Fillet.hs @@ -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) + diff --git a/src/Waterfall/Internal/Solid.hs b/src/Waterfall/Internal/Solid.hs --- a/src/Waterfall/Internal/Solid.hs +++ b/src/Waterfall/Internal/Solid.hs @@ -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 diff --git a/src/Waterfall/Revolution.hs b/src/Waterfall/Revolution.hs --- a/src/Waterfall/Revolution.hs +++ b/src/Waterfall/Revolution.hs @@ -31,4 +31,4 @@ solidBuilder <- MakeSolid.new liftIO $ MakeSolid.add solidBuilder =<< unsafeDowncast shell MakeShape.shape (upcast solidBuilder) -revolution _ = Solids.nowhere +revolution _ = Solids.emptySolid diff --git a/src/Waterfall/Solids.hs b/src/Waterfall/Solids.hs --- a/src/Waterfall/Solids.hs +++ b/src/Waterfall/Solids.hs @@ -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) diff --git a/src/Waterfall/Sweep.hs b/src/Waterfall/Sweep.hs --- a/src/Waterfall/Sweep.hs +++ b/src/Waterfall/Sweep.hs @@ -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 diff --git a/src/Waterfall/TwoD/Booleans.hs b/src/Waterfall/TwoD/Booleans.hs new file mode 100644 --- /dev/null +++ b/src/Waterfall/TwoD/Booleans.hs @@ -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) diff --git a/src/Waterfall/TwoD/Internal/Shape.hs b/src/Waterfall/TwoD/Internal/Shape.hs --- a/src/Waterfall/TwoD/Internal/Shape.hs +++ b/src/Waterfall/TwoD/Internal/Shape.hs @@ -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 diff --git a/src/Waterfall/TwoD/Shape.hs b/src/Waterfall/TwoD/Shape.hs --- a/src/Waterfall/TwoD/Shape.hs +++ b/src/Waterfall/TwoD/Shape.hs @@ -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) diff --git a/waterfall-cad.cabal b/waterfall-cad.cabal --- a/waterfall-cad.cabal +++ b/waterfall-cad.cabal @@ -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 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