waterfall-cad 0.6.2.1 → 0.6.3.0

raw patch · 25 files changed

+457/−155 lines, 25 filesdep ~opencascade-hsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: opencascade-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• src/Waterfall.hs +7/−4
• src/Waterfall/BoundingBox/AxisAligned.hs +1/−1
• src/Waterfall/BoundingBox/Oriented.hs +1/−1
• src/Waterfall/Diagram.hs +1/−1
• src/Waterfall/Error.hs +10/−0
• src/Waterfall/Fillet.hs +74/−19
• src/Waterfall/IO.hs +1/−3
• src/Waterfall/Internal/Edges.hs +3/−2
• src/Waterfall/Internal/Finalizers.hs +12/−0
• src/Waterfall/Internal/NearZero.hs +10/−0
• src/Waterfall/Internal/Solid.hs +5/−1
• src/Waterfall/Loft.hs +43/−11
• src/Waterfall/Offset.hs +37/−13
• src/Waterfall/Path/Common.hs +22/−15
• src/Waterfall/Revolution.hs +19/−10
• src/Waterfall/Solids.hs +24/−19
• src/Waterfall/Sweep.hs +21/−9
• src/Waterfall/Transforms.hs +95/−22
• src/Waterfall/TwoD/Booleans.hs +1/−1
• src/Waterfall/TwoD/Path2D.hs +7/−7
• src/Waterfall/TwoD/Shape.hs +6/−3
• src/Waterfall/TwoD/Text.hs +2/−5
• src/Waterfall/TwoD/Transforms.hs +44/−5
• waterfall-cad.cabal +5/−3

@@ -8,6 +8,12 @@  ## Unreleased +## 0.6.3.0++- Fixed an issue in `Waterfall.Transforms` where negative coefficients to `scale` would produce a broken `Solid`+- Added optics derived from the `Transformable` typeclass, `_translated`, `_scaled`, `_uScaled`, `_rotated`, `_mirrored` and their 2D equivalents.+- Operations that can fail (`roundFillet`, `chamfer`, `offset`, `loft`, `sweep`, `revolution` and their relatives) now fall back to an empty `Solid` rather than throwing. Added `try*` variants (`tryRoundFillet`, `tryOffset`, `tryLoft`, `trySweep`, `tryRevolution`, etc) that return `Either WaterfallError`, along with a new `Waterfall.Error` module.+ ## 0.6.2.1  - Fixed an off by one error in `Waterfall.TwoD.repeatLooping` that would produce overlapping wire segments in `repeatLooping`

@@ -12,11 +12,11 @@   module Waterfall.Solids -- | The functions in this module can be used to transform `Solid`s. , module Waterfall.Transforms--- | `Solid`'s can be combined together with +-- | `Solid`s can be combined together with  -- [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.+-- | 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.@@ -50,10 +50,12 @@ -- | Paths in 2D / 3D space. -- -- This module defines functions that can be used with "Waterfall.Path" or "Waterfall.TwoD.Path2D".--- Those modules both export monomorphized variants of the functions defined in this module.+-- Those modules both export monomorphised variants of the functions defined in this module. , module Waterfall.Path.Common--- | Generate 2D `Diagram`s from 3D `Shape`s+-- | Generate 2D `Diagram`s from 3D `Solid`s , module Waterfall.Diagram+-- | This module defines the Error type used by some functions+, module Waterfall.Error )where  import Waterfall.Booleans@@ -76,3 +78,4 @@ import Waterfall.TwoD.Path2D import Waterfall.TwoD.Shape import Waterfall.TwoD.Text+import Waterfall.Error

@@ -32,6 +32,6 @@ -- | A cuboid, specified by two diagonal vertices. --   -- This can be used to make a solid from the output of `axisAlignedBoundingBox` -aabbToSolid :: (V3 Double, V3 Double) -- ^ if this argument input is `(lo, hi)`, one vertex of the cuboid is placed at `lo`, the oposite vertex is at `hi`+aabbToSolid :: (V3 Double, V3 Double) -- ^ if this argument input is `(lo, hi)`, one vertex of the cuboid is placed at `lo`, the opposite vertex is at `hi`     -> Solid aabbToSolid (lo, hi) = translate lo $ box (hi ^-^ lo)

@@ -69,7 +69,7 @@ obbSideY :: OrientedBoundingBox -> V3 Double  obbSideY = getSide OBB.yDirection OBB.yHSize     --- | the "Z" side of the oriented bounding box+-- | The "Z" side of the oriented bounding box -- -- This is measured from the center to one face. -- So the length of this vector is _half_ of the side length of the bounding box.

@@ -34,7 +34,7 @@ import OpenCascade.Inheritance (upcast) import Control.Monad (forM_) --- | "Diagram" of a "Waterfall" part+-- | `Diagram` of a Waterfall part -- -- This is similar to a collection of `Path2D` -- indexed by `LineType` and `Visibility`

@@ -0,0 +1,10 @@+module Waterfall.Error+( WaterfallError (..)+) where++import Data.Data (Typeable)+import OpenCascade.Internal.Exception (OpenCascadeException)++newtype WaterfallError = WaterfallError +    { rawOpenCascadeError :: OpenCascadeException+    } deriving (Eq, Ord, Typeable, Show)

@@ -9,17 +9,24 @@   roundFillet , roundConditionalFillet , roundIndexedConditionalFillet+, tryRoundFillet+, tryRoundConditionalFillet+, tryRoundIndexedConditionalFillet -- * Chamfers -- | Adds flat faces at a constant angle to the two faces either side of an edge. , chamfer , conditionalChamfer , indexedConditionalChamfer+, tryChamfer+, tryConditionalChamfer+, tryIndexedConditionalChamfer -- * Utility Methods , whenNearlyEqual ) where -import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)+import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquireWithCatch) import Waterfall.Internal.Edges (edgeEndpoints)+import Waterfall.Error (WaterfallError) import qualified OpenCascade.BRepFilletAPI.MakeFillet as MakeFillet import qualified OpenCascade.BRepFilletAPI.MakeChamfer as MakeChamfer import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape@@ -32,8 +39,10 @@ import Control.Monad.IO.Class (liftIO) import OpenCascade.Inheritance (upcast, unsafeDowncast) import Linear.V3 (V3 (..))-import Linear.Epsilon +import Linear.Epsilon (Epsilon, nearZero) import Control.Lens (Lens', (^.))+import Data.Either (fromRight)+ 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@@ -53,6 +62,21 @@                         Explorer.next explorer                         go (hash:visited) (i + 1)  ++-- | Version of `roundIndexedConditionalFillet` that returns an `Either` on failure+tryRoundIndexedConditionalFillet+    :: (Integer -> (V3 Double, V3 Double) -> Maybe Double)+    -> Solid+    -> Either WaterfallError Solid+tryRoundIndexedConditionalFillet radiusFunction solid = solidFromAcquireWithCatch $ do+    s <- acquireSolid solid+    builder <- MakeFillet.fromShape s++    explorer <- Explorer.new s ShapeEnum.Edge+    liftIO $ addEdges radiusFunction (MakeFillet.addEdgeWithRadius builder) explorer++    MakeShape.shape (upcast builder)+ -- | Add rounds with the given radius 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 round\/fillet a `Solid`.@@ -62,15 +86,19 @@ -- 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 round\/fillet based on edge index is an \"easy\" way to round\/fillet these shapes. -roundIndexedConditionalFillet :: (Integer -> (V3 Double, V3 Double) -> Maybe Double) -> Solid -> Solid-roundIndexedConditionalFillet radiusFunction solid = solidFromAcquire $ do-    s <- acquireSolid solid-    builder <- MakeFillet.fromShape s+roundIndexedConditionalFillet+    :: (Integer -> (V3 Double, V3 Double) -> Maybe Double)+    -> Solid+    -> Solid+roundIndexedConditionalFillet radiusFunction solid = fromRight mempty $ tryRoundIndexedConditionalFillet radiusFunction solid -    explorer <- Explorer.new s ShapeEnum.Edge-    liftIO $ addEdges radiusFunction (MakeFillet.addEdgeWithRadius builder) explorer -    MakeShape.shape (upcast builder)+-- | Version of `roundConditionalFillet` that returns an `Either` on failure+tryRoundConditionalFillet +    :: ((V3 Double, V3 Double) -> Maybe Double)+    -> Solid +    -> Either WaterfallError Solid+tryRoundConditionalFillet f = tryRoundIndexedConditionalFillet (const f)  -- | Add rounds with the given radius to each edge of a solid, conditional on the endpoints of the edge. -- @@ -85,6 +113,25 @@ roundFillet r = roundConditionalFillet (const . pure $ r)  +-- | Version of `roundFillet` that returns an `Either` on failure+tryRoundFillet :: Double -> Solid -> Either WaterfallError Solid+tryRoundFillet r = tryRoundConditionalFillet (const . pure $ r)+++-- | Version of `indexedConditionalChamfer` that returns an `Either` on failure+tryIndexedConditionalChamfer +    :: (Integer -> (V3 Double, V3 Double) -> Maybe Double)+    -> Solid +    -> Either WaterfallError Solid+tryIndexedConditionalChamfer radiusFunction solid = solidFromAcquireWithCatch $ 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 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`.@@ -94,15 +141,19 @@ -- 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+indexedConditionalChamfer+    :: (Integer -> (V3 Double, V3 Double) -> Maybe Double)+    -> Solid +    -> Solid+indexedConditionalChamfer radiusFunction solid =+    fromRight mempty $ tryIndexedConditionalChamfer radiusFunction solid -    MakeShape.shape (upcast builder)+-- | Version of `conditionalChamfer` that returns an `Either` on failure+tryConditionalChamfer +    :: ((V3 Double, V3 Double) -> Maybe Double) +    -> Solid+    -> Either WaterfallError Solid+tryConditionalChamfer f = tryIndexedConditionalChamfer (const f)  -- | Add chamfers with the given size to each edge of a solid, conditional on the endpoints of the edge. -- @@ -110,13 +161,17 @@ 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+-- | Version of `chamfer` that returns an `Either` on failure+tryChamfer :: Double -> Solid -> Either WaterfallError Solid+tryChamfer d = tryConditionalChamfer (const . pure $ d)++-- | Add a chamfer with a given size 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) --- | Returns a value when the target of a lens on a two points are close to one another.+-- | Returns a value when the target of a lens on two points are close to one another. --  -- This can be used in combination with `roundConditionalFillet`/`conditionalChamfer`. --

@@ -75,7 +75,7 @@ data WaterfallIOExceptionCause =      -- | Something went wrong when accessing a file,     -- eg. a write to a file path that is unreachable,-    -- or a read to a file in the wrong format +    -- or a read from a file in the wrong format      FileError       -- | The contents of a file could not be converted into a `Waterfall.Solid`     -- e.g the file did not contain a solid object@@ -279,8 +279,6 @@ readGLB = readGLTF  -- | Read a `Solid` from an obj file at a given path------ This should support reading both the GLTF (json) and GLB (binary) formats readOBJ :: FilePath -> IO Solid readOBJ  = cafReader $ do     reader <- RWObj.CafReader.new 

@@ -28,6 +28,7 @@ import qualified OpenCascade.TopTools.ShapeMapHasher as TopTools.ShapeMapHasher import qualified OpenCascade.BRepBuilderAPI.MakeEdge as MakeEdge import qualified OpenCascade.BRepLib as BRepLib+import Waterfall.Internal.NearZero (nearZero) import OpenCascade.GeomAbs.Shape as GeomAbs.Shape import Waterfall.Internal.FromOpenCascade (gpPntToV3, gpVecToV3) import qualified OpenCascade.BRepAdaptor.Curve as BRepAdaptor.Curve@@ -36,7 +37,7 @@ import qualified OpenCascade.BRepGProp as BRepGProp import Data.Acquire import Control.Monad.IO.Class (liftIO)-import Linear (V3 (..), distance, normalize, nearZero)+import Linear (V3 (..), distance, normalize) import Foreign.Ptr import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire import Control.Monad (when)@@ -234,7 +235,7 @@                     edge <- liftIO $ WireExplorer.current explorer                     s' <- normalize <$> edgeTangentStart edge                     e' <- normalize <$> edgeTangentEnd edge-                    let startIsTangent = maybe True (nearZero . (s' -)) lastDelta+                    let startIsTangent = maybe True (all nearZero . (s' -)) lastDelta                     when startIsTangent $ do                             liftIO $ MakeWire.addEdge builder edge                             liftIO $ WireExplorer.next explorer

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-|  Module: Waterfall.Internal.Finalizers @@ -9,6 +10,7 @@ -} module Waterfall.Internal.Finalizers  ( unsafeFromAcquire+, unsafeFromAcquireWithCatch , unsafeFromAcquireT , fromAcquire , fromAcquireT@@ -24,6 +26,10 @@ import Data.Maybe (fromMaybe) import Control.Monad (forM, when) import Data.IORef (newIORef, atomicModifyIORef)+import Control.Exception (try)+import Control.Arrow (left)+import OpenCascade.Internal.Exception (OpenCascadeException)+import Waterfall.Error (WaterfallError (..))  -- | Convert a resource in the `Data.Acquire.Acquire` monad to a value in IO -- the `free` action of the resource is called when the underlying value goes out of scope of the Haskell garbage collection@@ -63,6 +69,12 @@ {-# NOINLINE unsafeFromAcquire #-} unsafeFromAcquire :: Acquire a -> a  unsafeFromAcquire = unsafePerformIO . fromAcquire++-- | Version of `unsafeFromAcquire` which returns a `WaterfallError` if the action throws+{-# NOINLINE unsafeFromAcquireWithCatch #-}+unsafeFromAcquireWithCatch :: Acquire a -> Either WaterfallError a+unsafeFromAcquireWithCatch = +    left WaterfallError . unsafePerformIO . try . fromAcquire  -- | Version of `unsafeFromAcquire`  which registers the finalizer on the _value_ in a container  {-# NOINLINE unsafeFromAcquireT #-}

@@ -0,0 +1,10 @@+module Waterfall.Internal.NearZero +( confusion+, nearZero+) where++confusion :: Double+confusion = 1e-7++nearZero :: Double -> Bool+nearZero = (<= confusion) . abs

@@ -4,6 +4,7 @@ ( Solid (..) , acquireSolid , solidFromAcquire+, solidFromAcquireWithCatch , union3D , difference3D , intersection3D@@ -28,9 +29,10 @@ 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)+import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire, unsafeFromAcquireWithCatch) import qualified OpenCascade.BOPAlgo.Builder as BOPAlgo import Data.Foldable (traverse_)+import Waterfall.Error (WaterfallError)  -- | The Boundary Representation of a solid object. --@@ -50,6 +52,8 @@ solidFromAcquire :: Acquire (Ptr TopoDS.Shape.Shape) -> Solid solidFromAcquire = Solid . unsafeFromAcquire +solidFromAcquireWithCatch :: Acquire (Ptr TopoDS.Shape.Shape) -> Either WaterfallError Solid+solidFromAcquireWithCatch = fmap Solid . unsafeFromAcquireWithCatch  -- | print debug information about a Solid when it's evaluated  -- exposes the properties of the underlying OpenCacade.TopoDS.Shape

@@ -3,40 +3,71 @@  [Loft](https://en.wikipedia.org/wiki/Loft_\(3D\)) is a method to create smooth 3D shapes.  -Analagous to the [lofting](https://en.wikipedia.org/wiki/Lofting) process in boat building. +Analogous to the [lofting](https://en.wikipedia.org/wiki/Lofting) process in boat building.  A loft is defined by planar cross-sections of the desired shape at chosen locations. -These cross-sections are then interpolated to form a smooth 3d shape.+These cross-sections are then interpolated to form a smooth 3D shape. -} module Waterfall.Loft ( pointedLoftWithPrecision , pointedLoft , loft+-- * Functions that return Errors+, tryPointedLoftWithPrecision+, tryPointedLoft+, tryLoft ) where  import Linear (V3 (..)) import Waterfall.Internal.Path (Path, rawPath)-import Waterfall.Internal.Solid (Solid (..), solidFromAcquire)+import Waterfall.Internal.Solid (Solid (..), solidFromAcquireWithCatch) import Waterfall.Internal.ToOpenCascade (v3ToVertex) import Waterfall.Internal.Path.Common (rawPathWire) import qualified OpenCascade.BRepOffsetAPI.ThruSections as ThruSections import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape+import Data.Either (fromRight) import OpenCascade.Inheritance (upcast) import Control.Monad.IO.Class (liftIO) import Control.Monad (forM_, (<=<))+import Waterfall.Error (WaterfallError) +-- | like `pointedLoftWithPrecision`, but returns an Either on error+tryPointedLoftWithPrecision :: Double -- ^ The loft precision, this should be a small value, e.g. @ 1e-6 @ +    -> Maybe (V3 Double) -- ^ Optional start point for the loft+    -> [Path] -- ^ Series of cross-sections that the loft will pass through+    -> Maybe (V3 Double) -- ^ Optional end point for the loft+    -> Either WaterfallError Solid+tryPointedLoftWithPrecision precision start paths end = solidFromAcquireWithCatch $ do+    thruSections <- ThruSections.new True False precision+    forM_ start ((liftIO . ThruSections.addVertex thruSections) <=< v3ToVertex)+    forM_ paths (traverse (liftIO . ThruSections.addWire thruSections) . rawPathWire . rawPath)+    forM_ end ((liftIO . ThruSections.addVertex thruSections) <=< v3ToVertex)+    MakeShape.shape (upcast thruSections)++-- | like `pointedLoft`, but returns an Either on error+tryPointedLoft :: +    Maybe (V3 Double) -- ^ Optional start point for the loft+    -> [Path] -- ^ Series of cross-sections that the loft will pass through+    -> Maybe (V3 Double) -- ^ Optional end point for the loft+    -> Either WaterfallError Solid+tryPointedLoft = tryPointedLoftWithPrecision defaultPrecision++-- | like `pointedLoft`, but returns an Either on error+tryLoft :: +    [Path] -- ^ Series of cross-sections that the loft will pass through+    -> Either WaterfallError Solid+tryLoft paths = tryPointedLoft Nothing paths Nothing++defaultPrecision :: Double+defaultPrecision = 1e-6+ -- | like `pointedLoft`, but allows the user to set the precision used by the underlying algorithm pointedLoftWithPrecision :: Double -- ^ The loft precision, this should be a small value, e.g. @ 1e-6 @      -> Maybe (V3 Double) -- ^ Optional start point for the loft     -> [Path] -- ^ Series of cross-sections that the loft will pass through     -> Maybe (V3 Double) -- ^ Optional end point for the loft     -> Solid-pointedLoftWithPrecision precision start paths end = -    solidFromAcquire $ do-        thruSections <- ThruSections.new True False precision-        forM_ start ((liftIO . ThruSections.addVertex thruSections) <=< v3ToVertex)-        forM_ paths (traverse (liftIO . ThruSections.addWire thruSections) . rawPathWire . rawPath)-        forM_ end ((liftIO . ThruSections.addVertex thruSections) <=< v3ToVertex)-        MakeShape.shape (upcast thruSections)+pointedLoftWithPrecision precision start paths end =+    fromRight mempty $ tryPointedLoftWithPrecision precision start paths end  -- | Form a Loft which may terminate at defined points. --@@ -47,10 +78,11 @@     -> [Path] -- ^ Series of cross-sections that the loft will pass through     -> Maybe (V3 Double) -- ^ Optional end point for the loft     -> Solid-pointedLoft = pointedLoftWithPrecision 1e-6+pointedLoft = pointedLoftWithPrecision defaultPrecision  -- | Form a loft between a series of cross-sections. loft ::      [Path] -- ^ Series of cross-sections that the loft will pass through     -> Solid loft paths = pointedLoft Nothing paths Nothing+

@@ -1,9 +1,12 @@ module Waterfall.Offset  ( offset , offsetWithTolerance+-- * Functions that return Errors+, tryOffset+, tryOffsetWithTolerance ) where  -import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)+import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquireWithCatch) import qualified OpenCascade.BRepOffsetAPI.MakeOffsetShape as MakeOffsetShape import Control.Monad.IO.Class (liftIO) import OpenCascade.Inheritance (SubTypeOf(upcast), unsafeDowncast)@@ -17,7 +20,9 @@ import Control.Monad (when) import Foreign.Ptr (Ptr) import Data.Acquire (Acquire)-import Linear.Epsilon (nearZero)+import Waterfall.Internal.NearZero (nearZero)+import Waterfall.Error (WaterfallError)+import Data.Either (fromRight)  combineShellsToSolid :: Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape) combineShellsToSolid s = do@@ -33,22 +38,32 @@     go     upcast <$> MakeSolid.solid makeSolid --- | like `offset`, but allows setting the tolerance parameter used by the algorithm -offsetWithTolerance :: -    Double       -- ^ Tolerance, this can be relatively small-    -> Double    -- ^ Amount to offset by, positive values expand, negative values contract-    -> Solid        -- ^ the `Solid` to offset -    -> Solid-offsetWithTolerance tolerance value solid-    | nearZero value = solid-    | otherwise = -  solidFromAcquire $ do+-- | Version of `offsetWithTolerance` that returns an error on failure+tryOffsetWithTolerance :: +    Double       +    -> Double   +    -> Solid   +    -> 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 +offsetWithTolerance :: +    Double       -- ^ Tolerance, this can be relatively small+    -> Double    -- ^ Amount to offset by, positive values expand, negative values contract+    -> Solid        -- ^ the `Solid` to offset +    -> Solid+offsetWithTolerance tolerance value solid = +    fromRight mempty $ tryOffsetWithTolerance tolerance value solid++defaultTolerance :: Double+defaultTolerance = 1e-6+ -- | Expand or contract a `Solid` by a certain amount. --  -- This is based on @MakeOffsetShape@ from the underlying OpenCascade library.@@ -67,4 +82,13 @@     Double    -- ^ Amount to offset by, positive values expand, negative values contract     -> Solid        -- ^ the `Solid` to offset      -> Solid-offset = offsetWithTolerance 1e-6 +offset = offsetWithTolerance defaultTolerance+++-- | Version of `offset` that returns an error on failure+tryOffset  :: +    Double    -- ^ Amount to offset by, positive values expand, negative values contract+    -> Solid        -- ^ the `Solid` to offset +    -> Either WaterfallError Solid+tryOffset = tryOffsetWithTolerance defaultTolerance+

@@ -39,8 +39,10 @@ import Waterfall.Internal.Finalizers (unsafeFromAcquire, toAcquire, unsafeFromAcquireT) import Waterfall.Internal.FromOpenCascade (gpPntToV3) import Waterfall.Internal.Edges (wireEndpoints, reverseWire, splitWires, wireLength, truncateWire)+import Waterfall.Internal.NearZero (nearZero) import Control.Arrow (second)-import Data.Foldable (foldl')+import Prelude hiding (Foldable(..))+import Data.Foldable (Foldable(..)) import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire import Control.Monad.IO.Class (liftIO) import qualified OpenCascade.BRepBuilderAPI.MakeEdge as MakeEdge@@ -52,7 +54,7 @@ import qualified OpenCascade.GP.Vec as  GP.Vec import qualified OpenCascade.BRepBuilderAPI.Transform as BRepBuilderAPI.Transform import Data.Proxy (Proxy (..))-import Linear (V3 (..), V2 (..), _xy, Epsilon, nearZero)+import Linear (V3 (..), V2 (..), _xy, Epsilon) import qualified OpenCascade.GP.Pnt as GP.Pnt import Control.Lens ((^.)) @@ -81,10 +83,13 @@     liftIO $ MakeWire.addEdge builder edge     MakeWire.wire builder +veryClose :: (AnyPath point path) => Proxy path -> point -> point -> Bool+veryClose proxy a b = all nearZero (pointToV3 proxy a - pointToV3 proxy b)+ -- | A straight line between two points-line :: forall point path. (AnyPath point path, Epsilon point) => point -> point -> path+line :: forall point path. (AnyPath point path) => point -> point -> path line start end = -    if nearZero (start - end)+    if veryClose (Proxy :: Proxy path) start end         then reconstructPath . SinglePointRawPath . pointToV3 (Proxy :: Proxy path) $ start         else edgeToPath $ do             pt1 <- pointToGPPnt (Proxy :: Proxy path) start@@ -92,7 +97,7 @@             MakeEdge.fromPnts pt1 pt2  -- | Version of `line` designed to work with `pathFrom`-lineTo :: (AnyPath point path, Epsilon point) => point -> point -> (point, path)+lineTo :: (AnyPath point path) => point -> point -> (point, path) lineTo end = \start -> (end, line start end)   -- | Version of `line` designed to work with `pathFrom`@@ -105,9 +110,10 @@     lineTo end  -- | Section of a circle based on three arguments, the start point, a point on the arc, and the endpoint-arcVia :: forall point path. (AnyPath point path, Epsilon point) => point -> point -> point -> path+arcVia :: forall point path. (AnyPath point path) => point -> point -> point -> path arcVia start mid end =-    if nearZero (start - end) && nearZero (start - mid) +    let vc = veryClose (Proxy :: Proxy path)+    in if vc start end && vc start mid         then reconstructPath . SinglePointRawPath . pointToV3 (Proxy :: Proxy path) $ start         else edgeToPath $ do             s <- pointToGPPnt (Proxy :: Proxy path) start@@ -120,13 +126,13 @@ -- -- The first argument is a point on the arc -- The second argument is the endpoint of the arc-arcViaTo :: (AnyPath point path, Epsilon point) => point -> point -> point -> (point, path)+arcViaTo :: (AnyPath point path) => point -> point -> point -> (point, path) arcViaTo mid end = \start -> (end, arcVia start mid end)   -- | Version of `arcVia` designed to work with `pathFrom` --  -- With relative points; specifying the distance of the midpoint and endpoint--- relative to the start of the line, rather than in absolute space.+-- relative to the start of the arc, rather than in absolute space. arcViaRelative :: (AnyPath point path, Epsilon point) => point -> point -> point -> (point, path) arcViaRelative dMid dEnd = do     mid <- (+ dMid) @@ -136,9 +142,10 @@ -- | Bezier curve of order 3 --  -- The arguments are, the start of the curve, the two control points, and the end of the curve-bezier :: forall point path. (AnyPath point path, Epsilon point) => point -> point -> point -> point -> path+bezier :: forall point path. (AnyPath point path) => point -> point -> point -> point -> path bezier start controlPoint1 controlPoint2 end = -    if nearZero (start - end) && nearZero (start - controlPoint1) && nearZero (start - controlPoint2)+    let vc = veryClose (Proxy :: Proxy path)+    in if vc start end && vc start controlPoint1 && vc start controlPoint2         then reconstructPath . SinglePointRawPath . pointToV3 (Proxy :: Proxy path) $ start         else edgeToPath $ do             s <- pointToGPPnt (Proxy :: Proxy path) start@@ -155,13 +162,13 @@             MakeEdge.fromCurve (upcast b)  -- | Version of `bezier` designed to work with `pathFrom`-bezierTo :: (AnyPath point path, Epsilon point) => point -> point -> point -> point -> (point, path)+bezierTo :: (AnyPath point path) => point -> point -> point -> point -> (point, path) bezierTo controlPoint1 controlPoint2 end = \start -> (end, bezier start controlPoint1 controlPoint2 end)   -- | Version of `bezier` designed to work with `pathFrom` --  -- With relative points; specifying the distance of the control points and the endpoint--- relative to the start of the line, rather than in absolute space.+-- relative to the start of the curve, rather than in absolute space. bezierRelative :: (AnyPath point path, Epsilon point) => point -> point -> point -> point -> (point, path) bezierRelative dControlPoint1 dControlPoint2 dEnd = do     controlPoint1 <- (+ dControlPoint1)@@ -232,10 +239,10 @@         _ -> (pnt, reconstructPath EmptyRawPath)  -- | Given a path, return a new path with the endpoints joined by a straight line.-closeLoop :: (AnyPath point path, Monoid path, Epsilon point) => path -> path+closeLoop :: forall point path. (AnyPath point path, Monoid path) => path -> path closeLoop p =      case pathEndpoints p of-        Just (s, e) -> if nearZero (s - e) +        Just (s, e) -> if veryClose (Proxy :: Proxy path) s e              then p             else p <> line e s         Nothing -> p

@@ -1,8 +1,9 @@-module Waterfall.Revolution +module Waterfall.Revolution ( revolution+, tryRevolution ) where -import Waterfall.Internal.Solid (Solid (..), solidFromAcquire, emptySolid)+import Waterfall.Internal.Solid (Solid (..), solidFromAcquireWithCatch) import Waterfall.TwoD.Internal.Path2D (Path2D (..)) import Waterfall.Internal.Finalizers (toAcquire) import qualified OpenCascade.BRepPrimAPI.MakeRevol as MakeRevol@@ -11,18 +12,18 @@ import qualified OpenCascade.GP as GP import OpenCascade.Inheritance (upcast, unsafeDowncast) import Waterfall.Transforms (rotate)+import Waterfall.Error (WaterfallError) import Control.Monad.IO.Class (liftIO) import Linear (unit, _x) import Waterfall.Internal.Path.Common (RawPath(..))+import Data.Either (fromRight) --- | Construct a `Solid` of revolution from a `Path2D`.+-- | Version of `revolution` that returns an `Error` on failure. ----- The `Path2D` is rotated about the y axis, should have endpoints that lie on it ( \(x = 0\) ).--- --- The resulting `Solid` is rotated such that the axis of revolution is the z axis.-revolution :: Path2D -> Solid-revolution (Path2D (ComplexRawPath theRawPath)) = -    rotate (unit _x) (pi/2) . solidFromAcquire $ do+-- Revolution can fail, for example, if the `Path2D` crosses the axis of revolution.+tryRevolution :: Path2D -> Either WaterfallError Solid+tryRevolution (Path2D (ComplexRawPath theRawPath)) =+    fmap (rotate (unit _x) (pi/2)) . solidFromAcquireWithCatch $ do         p <- toAcquire theRawPath         axis <- GP.oy -- revolve around the y axis         revol <- MakeRevol.fromShapeAndAx1 (upcast p) axis True@@ -30,4 +31,12 @@         solidBuilder <- MakeSolid.new         liftIO $ MakeSolid.add solidBuilder =<< unsafeDowncast shell         MakeShape.shape (upcast solidBuilder)-revolution _ = emptySolid+tryRevolution _ = Right mempty++-- | Construct a `Solid` of revolution from a `Path2D`.+--+-- The `Path2D` is rotated about the y axis, should have endpoints that lie on it ( \(x = 0\) ).+--+-- The resulting `Solid` is rotated such that the axis of revolution is the z axis.+revolution :: Path2D -> Solid+revolution = fromRight mempty . tryRevolution

@@ -27,6 +27,7 @@ import Waterfall.Internal.FromOpenCascade (gpPntToV3) import Waterfall.Internal.Remesh (makeSolidFromShell) import Waterfall.Transforms (translate, rotate)+import Waterfall.Internal.NearZero (nearZero) import qualified Waterfall.TwoD.Shape as TwoD.Shape import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape import qualified OpenCascade.BRepBuilderAPI.MakeEdge as MakeEdge@@ -76,11 +77,13 @@  -- | A cuboid, one vertex on the origin, another on a given point box :: V3 Double -> Solid-box (V3 x y z) = solidFromAcquire $ do-    a <- GP.origin-    b <- GP.Pnt.new x y z-    builder <- MakeBox.fromPnts a b-    Inheritance.upcast <$> MakeBox.solid builder+box v@(V3 x y z) +    | any nearZero v = mempty+    | otherwise = solidFromAcquire $ do+        a <- GP.origin+        b <- GP.Pnt.new x y z+        builder <- MakeBox.fromPnts a b+        Inheritance.upcast <$> MakeBox.solid builder       -- | A sphere with radius of 1, centered on the origin@@ -88,27 +91,28 @@ unitSphere = solidFromAcquire $ Inheritance.upcast <$> MakeSphere.fromRadius 1  -- | A cylinder with radius 1, length 1,--- one of it's circular faces centered on the origin,+-- one of its circular faces centered on the origin, -- the other centered on \( (0, 0, 1) \) unitCylinder :: Solid unitCylinder = solidFromAcquire $ Inheritance.upcast <$> MakeCylinder.fromRadiusAndHeight 1 1  -- | A cylinder with radius 1, length 1,--- centered on the origin,+-- centered on the origin centeredCylinder :: Solid centeredCylinder = translate (unit _z ^* (-0.5)) $ unitCylinder   -- | A Torus, with the axis of revolution about the Z axis -- --- Warning, this will generate malformed geometry if asked to generate a Spindle Torus+-- Warning, this will fail to generate geometry if asked to generate a Spindle Torus -- (when the Major Radius is smaller than the Minor Radius) torus ::-    Double -- ^ The Major Radius (Distance from center of torus to center of cube)-    -> Double -- ^ The Minor Radius (Distance from center of torus to center of )+    Double -- ^ The Major Radius (Distance from center of torus to center of tube)+    -> Double -- ^ The Minor Radius (Distance from center of tube to the surface of the torus)     -> Solid-torus major minor = -    solidFromAcquire+torus major minor +    | major < minor = mempty  +    | otherwise = solidFromAcquire          $ MakeShape.shape           . Inheritance.upcast           =<< MakeTorus.fromRadii major minor@@ -119,16 +123,17 @@ unitCone :: Solid unitCone = solidFromAcquire $ Inheritance.upcast <$> MakeCone.fromTwoRadiiAndHeight 0 1 1 --- | Extruded a 2D face into a prism with a given length \(len\).+-- | Extrude a 2D face into a prism with a given length \(len\). ----- One of the prisms faces lies on the plane \(z = 0\),+-- One of the prism's faces lies on the plane \(z = 0\), -- the other on the plane \(z = len\). prism :: Double -> TwoD.Shape.Shape -> Solid-prism len face = solidFromAcquire $ do-    p <- toAcquire . rawShape $ face-    v <- GP.Vec.new 0 0 len-    MakePrism.fromVec p v True True-    +prism len face +    | nearZero len = mempty+    | otherwise = solidFromAcquire $ do+        p <- toAcquire . rawShape $ face+        v <- GP.Vec.new 0 0 len+        MakePrism.fromVec p v True True  faceFromVerts :: [V3 Double] -> Acquire (Ptr TopoDS.Face) faceFromVerts pnts = do

@@ -1,12 +1,14 @@ module Waterfall.Sweep ( sweep+, trySweep ) where -import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)+import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire, solidFromAcquireWithCatch) import Waterfall.Internal.Path (Path (..)) import Waterfall.Internal.Path.Common (RawPath (..)) import Waterfall.Internal.Edges (wireTangentStart, wireEndpoints) import Waterfall.Internal.Finalizers (toAcquire)+import Waterfall.Internal.NearZero (nearZero) import Waterfall.Transforms (rotate, translate) import Waterfall.TwoD.Internal.Shape (Shape (..)) import qualified OpenCascade.BRepOffsetAPI.MakePipe as MakePipe@@ -15,27 +17,32 @@ import qualified OpenCascade.TopoDS as TopoDS import Control.Monad.IO.Class (liftIO) import Foreign.Ptr-import Linear (V3, normalize, unit, _x, _z, nearZero, cross, dot)+import Linear (V3, normalize, unit, _x, _z, cross, dot) import Data.Acquire (Acquire)-import qualified Waterfall.Solids as Solids+import Waterfall.Error (WaterfallError)+import Data.Either (fromRight)  rotateFace :: V3 Double -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape) rotateFace v face =      let vn = normalize v         z = unit _z-        in if nearZero (vn - z)+        in if all nearZero (vn - z)             then pure face             else-                let axis = if nearZero (vn + z) then unit _x else z `cross` vn+                let axis = +                        if all nearZero (vn + z)+                            then unit _x +                            else z `cross` vn                     angle = acos (vn `dot` z)                 in acquireSolid . rotate axis angle . solidFromAcquire . pure $ face   positionFace :: V3 Double -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape) positionFace p = acquireSolid . translate p . solidFromAcquire . pure --- | Sweep a 2D `Shape` along a `Path`, constructing a `Solid`-sweep :: Path -> Shape -> Solid-sweep (Path (ComplexRawPath theRawPath)) (Shape theRawShape) = solidFromAcquire $ do++-- | Version of `sweep` that returns an Error on Failure+trySweep :: Path -> Shape -> Either WaterfallError Solid+trySweep (Path (ComplexRawPath theRawPath)) (Shape theRawShape) = solidFromAcquireWithCatch $ do     path <- toAcquire theRawPath     shape <- toAcquire theRawShape     tangent <- liftIO $ wireTangentStart path@@ -43,4 +50,9 @@     adjustedFace <- positionFace start =<< rotateFace tangent shape     builder <- MakePipe.fromWireAndShape path adjustedFace     MakeShape.shape (upcast builder)-sweep _ _ = Solids.emptySolid+trySweep _ _ = Right mempty+++-- | Sweep a 2D `Shape` along a `Path`, constructing a `Solid`+sweep :: Path -> Shape -> Solid+sweep path shape = fromRight mempty $ trySweep path shape

@@ -1,20 +1,29 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ImpredicativeTypes #-} module Waterfall.Transforms-( Transformable+( -- * Transformations+  Transformable , matTransform , scale , uScale , rotate , translate , mirror+  -- * Optics+, _translated+, _scaled+, _uScaled+, _rotated+, _mirrored ) where import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire) import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)  import Waterfall.Internal.Path.Common (RawPath(..))+import Waterfall.Internal.NearZero (nearZero) import Linear.V3 (V3 (..)) import Linear.V4 (V4 (..))-import Linear (M34, (*^), normalize, dot, (!*), unit, _w, _xyz)+import Linear (M34, (*^), normalize, dot, (!*), unit, _w, _xyz, _x, _y, _z) import qualified Linear.Quaternion as Quaternion import qualified OpenCascade.GP.Trsf as GP.Trsf import qualified OpenCascade.GP as GP@@ -25,13 +34,14 @@ import qualified OpenCascade.GP.Vec as GP.Vec import qualified OpenCascade.BRepBuilderAPI.Transform  as BRepBuilderAPI.Transform import qualified OpenCascade.BRepBuilderAPI.GTransform  as BRepBuilderAPI.GTransform+import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Data.Acquire import Foreign.Ptr import Waterfall.Internal.Path (Path(..)) import OpenCascade.Inheritance (upcast, unsafeDowncast) import Data.Function ((&))-import Control.Lens ((.~))+import Control.Lens ((.~), Iso', iso)  -- | Typeclass for objects that can be manipulated in 3D space class Transformable a where@@ -40,13 +50,13 @@     -- | Scale by different amounts along the x, y and z axes     scale :: V3 Double -> a -> a     -- Uniform Scale-    -- | Scale uniformally along all axes+    -- | Scale uniformly along all axes     uScale :: Double -> a -> a     -- | Rotate by Axis and Angle (in radians)     rotate :: V3 Double -> Double -> a -> a     -- | Translate by a vector in 3D space     translate :: V3 Double -> a -> a-    -- | Mirror in the plane, which passes through the origin, tangent to the specified vector+    -- | Mirror in the plane, which passes through the origin, perpendicular to the specified vector     mirror :: V3 Double -> a -> a  fromTrsfSolid :: Acquire (Ptr GP.Trsf) -> Solid -> Solid@@ -61,6 +71,10 @@     trsf <- mkTrsf      BRepBuilderAPI.GTransform.gtransform solid trsf True  +transformPathSinglePointPaths :: (V3 Double -> V3 Double) -> Path -> Path+transformPathSinglePointPaths f (Path (SinglePointRawPath v)) = Path . SinglePointRawPath . f $ v +transformPathSinglePointPaths _ p = p + fromTrsfPath :: (V3 Double -> V3 Double) -> Acquire (Ptr GP.Trsf) -> Path -> Path fromTrsfPath _ mkTrsf (Path (ComplexRawPath p)) = Path . ComplexRawPath . unsafeFromAcquire $ do      path <- toAcquire p@@ -77,21 +91,48 @@ fromGTrsfPath f _ (Path (SinglePointRawPath v)) = Path . SinglePointRawPath . f $ v fromGTrsfPath _ _ (Path EmptyRawPath) = Path EmptyRawPath -scaleTrsf :: V3 Double -> Maybe (Either (Acquire (Ptr GP.Trsf)) (Acquire (Ptr GP.GTrsf)))-scaleTrsf v@(V3 x y z ) = -    if v == V3 1 1 1 -        then Nothing-        else -            if x == y && y == z-                then Just . Left $ uScaleTrsf x-                else Just . Right $ do-                    trsf <- GP.GTrsf.new +applyScaleTrsf :: +    (Acquire (Ptr GP.Trsf) -> a -> a) +    -> (Acquire (Ptr GP.GTrsf) -> a -> a)+    -> (Maybe (Acquire (Ptr GP.Trsf)), Maybe (Acquire (Ptr GP.GTrsf)))+    -> a -> a+applyScaleTrsf applyTrsf applyGTrsf (maybeTrsf, maybeGTrsf) = +     maybe id applyTrsf maybeTrsf . maybe id applyGTrsf maybeGTrsf+    +scaleTrsf :: V3 Double -> (Maybe (Acquire (Ptr GP.Trsf)), Maybe (Acquire (Ptr GP.GTrsf)))+scaleTrsf (V3 1 1 1) = (Nothing, Nothing)+scaleTrsf (V3 x y z ) =+    let isUniform = abs x == abs y && abs y == abs z +        isAllPositive = x >= 0 && y >= 0 && z >= 0+    in if isUniform && isAllPositive+        then (Just $ uScaleTrsf x, Nothing)+        else ( if isAllPositive +                then Nothing +                else Just $ do+                    trsf <- if isUniform +                        then uScaleTrsf (abs x)+                        else GP.Trsf.new +                    when (x < 0) $ do+                        mirrorX <- mirrorTrsf (unit _x)+                        liftIO $ GP.Trsf.multiply trsf mirrorX+                    when (y < 0) $ do+                        mirrorY <- mirrorTrsf (unit _y)+                        liftIO $ GP.Trsf.multiply trsf mirrorY+                    when (z < 0) $ do+                        mirrorZ <- mirrorTrsf (unit _z)+                        liftIO $ GP.Trsf.multiply trsf mirrorZ+                    return trsf+            , if isUniform+                then Nothing+                else Just $ do+                    gtrsf <- GP.GTrsf.new                      liftIO $ do-                        GP.GTrsf.setValue trsf 1 1 x-                        GP.GTrsf.setValue trsf 2 2 y-                        GP.GTrsf.setValue trsf 3 3 z-                        GP.GTrsf.setForm trsf-                        return trsf+                        GP.GTrsf.setValue gtrsf 1 1 (abs x)+                        GP.GTrsf.setValue gtrsf 2 2 (abs y)+                        GP.GTrsf.setValue gtrsf 3 3 (abs z)+                        GP.GTrsf.setForm gtrsf+                        return gtrsf+            )  uScaleTrsf :: Double -> Acquire (Ptr GP.Trsf) uScaleTrsf factor = do@@ -152,7 +193,8 @@     matTransform = maybe id (either fromTrsfSolid fromGTrsfSolid) . matrixGTrsf           scale :: V3 Double -> Solid -> Solid-    scale = maybe id (either fromTrsfSolid fromGTrsfSolid) . scaleTrsf+    scale factor = +        applyScaleTrsf fromTrsfSolid fromGTrsfSolid (scaleTrsf factor)      uScale :: Double -> Solid -> Solid     uScale = fromTrsfSolid . uScaleTrsf@@ -173,9 +215,9 @@         in maybe id (either (fromTrsfPath transformPnt) (fromGTrsfPath transformPnt)) $ matrixGTrsf m          scale :: V3 Double -> Path -> Path-    scale s = +    scale s =         let transformPnt = scale s -        in maybe id (either (fromTrsfPath transformPnt) (fromGTrsfPath transformPnt)) $ scaleTrsf s+        in transformPathSinglePointPaths transformPnt . applyScaleTrsf (fromTrsfPath id) (fromGTrsfPath id) (scaleTrsf s)      uScale :: Double -> Path -> Path     uScale s = fromTrsfPath (uScale s) (uScaleTrsf s)@@ -211,3 +253,34 @@         let nm = normalize mirrorVec         in toMirror - (2 * (nm `dot` toMirror) *^ nm) +-- | Every translation is an isomorphism+_translated :: Transformable t => V3 Double -> Iso' t t+_translated v = iso (translate v) (translate (negate v))++-- | A scale by @v@ as an isomorphism+--+-- Returns 'Nothing' when any component of @v@ is (near) zero,+-- as a scale that collapses an axis has no inverse.+_scaled :: Transformable t => V3 Double -> Maybe (Iso' t t)+_scaled v =+    if any nearZero v+        then Nothing+        else Just $ iso (scale v) (scale (1/v))++-- | A scale by @s@ as an isomorphism+--+-- Returns 'Nothing' when @s@ is (near) zero,+--  as a scale that collapses everything to the origin has no inverse.+_uScaled :: Transformable t => Double -> Maybe (Iso' t t)+_uScaled s = +    if nearZero s+        then Nothing +        else Just $ iso (uScale s) (uScale (1/s))++-- | Every rotation is an isomorphism+_rotated :: Transformable t => V3 Double -> Double -> Iso' t t+_rotated axis angle = iso (rotate axis angle) (rotate axis (negate angle))++-- | Every mirror is an isomorphism+_mirrored :: Transformable t => V3 Double -> Iso' t t+_mirrored v = let f = mirror v in iso f f 

@@ -1,5 +1,5 @@ {-|-[Boolean Operations](https://en.wikipedia.org/wiki/Boolean_operations_on_polygons) operations on `Shape`.+[Boolean Operations](https://en.wikipedia.org/wiki/Boolean_operations_on_polygons) on `Shape`. -} module Waterfall.TwoD.Booleans ( union2D

@@ -33,9 +33,10 @@  import Waterfall.TwoD.Internal.Path2D (Path2D(..)) import Waterfall.TwoD.Transforms (rotate2D)+import Waterfall.Internal.NearZero (nearZero) import Linear.V2 (V2(..)) import Control.Lens ((^.))-import Linear ((^*), _xy, distance, normalize, unangle, nearZero)+import Linear ((^*), _xy, distance, normalize, unangle) import Waterfall.Path.Common  data Sense = Clockwise | Counterclockwise deriving (Eq, Show)@@ -68,17 +69,16 @@ -- | Version of `arc` designed to work with `pathFrom` --  -- With relative points; specifying the distance of the endpoint--- relative to the start of the line, rather than in absolute space.+-- relative to the start of the arc, rather than in absolute space. arcRelative :: Sense -> Double -> V2 Double -> V2 Double -> (V2 Double, Path2D) arcRelative sense radius dEnd = do     end <- (+ dEnd)     arcTo sense radius end --- | Given a Path where both endpoints are equidistant from the origin.------ And which subtends an angle \( φ \) from the origin that evenly divides a complete revolution, such that \(n φ = 2 π \).+-- | Given a Path where both endpoints are equidistant from the origin,+-- and which subtends an angle \( φ \) from the origin that evenly divides a complete revolution, such that \(n φ = 2 π \). -- --- Replicates the path \( n \) times, rotating it by \( φ \), until the resulting path completes one revolution around the origin.+-- `repeatLooping` replicates the path \( n \) times, rotating it by \( φ \), until the resulting path completes one revolution around the origin. -- -- This can be used to construct paths with rotational symmetry, such as regular polygons, or gears. repeatLooping :: Path2D -> Path2D@@ -162,7 +162,7 @@ splitPath2D :: Path2D -> [Path2D] splitPath2D = splitPath --- | `pathLength` with the type fixed to `Path`+-- | `pathLength` with the type fixed to `Path2D` pathLength2D :: Path2D -> Double pathLength2D = pathLength 

@@ -39,8 +39,11 @@ -- Ideally: -- -- @--- shapePaths . fromPath ≡ pure+-- shapePaths . makeShape ≡ pure -- @+-- +-- Although this can only hold when the shape has one boundary path, +-- and is not guaranteed shapePaths :: Shape -> [Path2D]  shapePaths (Shape r) = fmap (Path2D . ComplexRawPath) . unsafeFromAcquire $ do     s <- toAcquire r @@ -69,10 +72,10 @@  -- | \(n\) sided Polygon, centered on the origin -- --- Ill-defined when n <= 2+-- Empty when n <= 2 unitPolygon :: Integer -> Shape unitPolygon n -    | n <= 2 = error "Polygon with <= 2 points is ill defined"+    | n <= 2 = mempty     | otherwise =          let n' = fromIntegral n             points = [

@@ -21,7 +21,7 @@  newtype Font = Font { rawFont :: Ptr BRepFont.BRepFont } --- | create a font from a filepath and a font size +-- | Create a font from a filepath and a font size  fontFromPath :: FilePath -> Double -> IO Font  fontFromPath fontpath size = do     bRepFont <- fromAcquire $ BRepFont.new@@ -37,10 +37,7 @@     unless (fontOk) $ throwIO $ WaterfallIOException FileError (name <> "::" <> show aspect)     return $ Font bRepFont --- | Render text, using the font from the provided filepath, at a given size.------ The IO of actually loading the font/checking the file exists is defered --- until the Shape is actually used+-- | Render text, using a given font text :: Font -> String -> Shape.Shape  text font content = Shape.Shape . unsafeFromAcquire $ do     axis <- GP.Ax3.new

@@ -1,17 +1,26 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ImpredicativeTypes #-} module Waterfall.TwoD.Transforms-( Transformable2D+( -- * Transformations+ Transformable2D , matTransform2D , rotate2D , scale2D , uScale2D , translate2D , mirror2D+-- * Optics+, _translated2D+, _scaled2D+, _uScaled2D+, _rotated2D+, _mirrored2D ) where  import Waterfall.TwoD.Internal.Path2D (Path2D (..)) import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)+import Waterfall.Internal.NearZero (nearZero) import Linear ((*^), normalize, dot, V3 (..), V2 (..), (!*), _xy, _z, unit, M23) import qualified OpenCascade.GP.Trsf as GP.Trsf import qualified OpenCascade.GP as GP@@ -28,7 +37,7 @@ import Foreign.Ptr import Waterfall.TwoD.Internal.Shape (Shape(..)) import Data.Function ((&))-import Control.Lens ((.~), (%~))+import Control.Lens ((.~), (%~), Iso', iso) import Control.Monad (forM) import Waterfall.Internal.Path.Common (RawPath(..)) import Waterfall.Internal.Diagram (RawDiagram (..))@@ -41,14 +50,14 @@     rotate2D :: Double -> a -> a     -- | Scale by different amounts along the x and y axes     scale2D :: V2 Double -> a -> a-    -- | Scale uniformally along both axes+    -- | Scale uniformly along both axes     uScale2D :: Double -> a -> a     -- | Translate by a distance in 2D space     translate2D :: V2 Double -> a -> a-    -- | Mirror in the line, which passes through the origin, tangent to the specified vector+    -- | Mirror in the line, which passes through the origin, perpendicular to the specified vector     --      -- Note that in order to maintain consistency with 'Waterfall.Transforms.Transformable',-    -- the mirror is in the line / tangent / to the vector, not in the line / parallel / to the vector+    -- the mirror is in the line / perpendicular / to the vector, not in the line / parallel / to the vector     mirror2D :: V2 Double -> a -> a  fromTrsfPath :: (V2 Double -> V2 Double) -> Acquire (Ptr GP.Trsf) -> Path2D -> Path2D@@ -238,3 +247,33 @@     mirror2D mirrorVec toMirror =          let nm = normalize mirrorVec         in toMirror - (2 * (nm `dot` toMirror) *^ nm)++-- | Every translation is an isomorphism+_translated2D :: Transformable2D t => V2 Double -> Iso' t t+_translated2D v = iso (translate2D v) (translate2D (negate v))++-- | A scale by @v@ as an isomorphism+--+-- Returns 'Nothing' when any component of @v@ is (near) zero,+-- as a scale that collapses an axis has no inverse.+_scaled2D :: Transformable2D t => V2 Double -> Maybe (Iso' t t)+_scaled2D v = if any nearZero v+    then Nothing+    else Just $ iso (scale2D v) (scale2D (1/v))++-- | A scale by @s@ as an isomorphism+--+-- Returns 'Nothing' when @s@ is (near) zero,+--  as a scale that collapses everything to the origin has no inverse.+_uScaled2D :: Transformable2D t => Double -> Maybe (Iso' t t)+_uScaled2D s = if nearZero s+    then Nothing+    else Just $ iso (uScale2D s) (uScale2D (1/s))++-- | Every rotation is an isomorphism+_rotated2D :: Transformable2D t => Double -> Iso' t t+_rotated2D angle = iso (rotate2D angle) (rotate2D (negate angle))++-- | Every mirror is an isomorphism+_mirrored2D :: Transformable2D t => V2 Double -> Iso' t t+_mirrored2D v = let f = mirror2D v in iso f f

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack  name:           waterfall-cad-version:        0.6.2.1+version:        0.6.3.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@@ -34,11 +34,13 @@       Waterfall.BoundingBox.AxisAligned       Waterfall.BoundingBox.Oriented       Waterfall.Diagram+      Waterfall.Error       Waterfall.Fillet       Waterfall.Internal.Diagram       Waterfall.Internal.Edges       Waterfall.Internal.Finalizers       Waterfall.Internal.FromOpenCascade+      Waterfall.Internal.NearZero       Waterfall.Internal.Path       Waterfall.Internal.Path.Common       Waterfall.Internal.Remesh@@ -71,7 +73,7 @@     , lattices >=2.0 && <3     , lens ==5.*     , linear >=1.21 && <2-    , opencascade-hs >=0.6.2.1 && <0.7+    , opencascade-hs >=0.6.3.0 && <0.7     , primitive >=0.7 && <0.10     , resourcet >=1.2 && <1.4   default-language: Haskell2010