waterfall-cad 0.2.1.0 → 0.2.2.0

raw patch · 10 files changed

+458/−44 lines, 10 filesdep +filepathdep ~opencascade-hsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: filepath

Dependency ranges changed: opencascade-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−1
• README.md +2/−0
• src/Waterfall.hs +39/−7
• src/Waterfall/IO.hs +227/−18
• src/Waterfall/Internal/Finalizers.hs +15/−0
• src/Waterfall/Internal/Remesh.hs +127/−0
• src/Waterfall/Internal/Solid.hs +5/−10
• src/Waterfall/Offset.hs +21/−4
• src/Waterfall/TwoD/Text.hs +4/−2
• waterfall-cad.cabal +4/−2

@@ -9,11 +9,24 @@  ## Unreleased +## 0.2.2.0++### Added +- New functions in `Waterfall.IO`+    - Support for reading (as well as writing) all file formats+        - `readSTL`, `readSTEP`, `readGLTF`, `readGLB`, `readOBJ`+    - (Wavefront) OBJ support (`writeOBJ`)+    - Convenience methods `readSolid` and `writeSolid` inferring the format from the file extension++### Changed++- Make error handling for actions in `Waterfall.Text` throw a `WaterfallIOException` on failure ## 0.2.1.0  ### Added -- graphicsLibraryTransmissionFormat support: `writeGLTF` and `writeGLB` in `Waterfall.IO`+- GLTF (graphics library transmission format) support: `writeGLTF` and `writeGLB` in `Waterfall.IO`+- obj file format support `writeOBJ` in `Waterfall.IO`  ## 0.2.0.0 

@@ -1,5 +1,7 @@ # Waterfall CAD  +![Waterfall CAD](https://raw.githubusercontent.com/joe-warren/opencascade-hs/main/images/logo/waterfall-cad-logo-name.svg)+ Waterfall CAD is a declarative CAD/Solid Modeling library.  This uses [opencascade-hs](https://hackage.haskell.org/package/opencascade-hs) as the kernel, but provides a "more functional" API over it.

@@ -1,21 +1,53 @@+{-| +Module: Waterfall++This module simply re-exports everything from the various modules+that make up the waterfall-cad package.+-} module Waterfall -( module Waterfall.Booleans+(+-- | `Solid` is the main data type in the Waterfall-CAD API,+-- The "Waterfall.Solids" module is the easiest way to construct +-- instances of `Solid`.+  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 +-- [Constructive Solid Geometry](https://en.wikipedia.org/wiki/Constructive_solid_geometry).+, module Waterfall.Booleans , module Waterfall.Booleans.Operators+-- | Once you've generated a `Solid`, +-- the functions in `Waterfall.IO` can be used to save it.+-- +-- The `Waterfall.IO` module also supports reading `Solid`s from a variety of file formats.+, module Waterfall.IO+-- | Calculating Axis Aligned Bounding Boxes from a `Solid`. , module Waterfall.BoundingBox.AxisAligned+-- | Calculating Oriented Bounding Boxes from a `Solid`. , module Waterfall.BoundingBox.Oriented+-- |  This module deals with adding rounds\/fillets\/bevels to a `Solid`. , module Waterfall.Fillet-, module Waterfall.IO+-- |  This module deals with offsetting a `Solid`: either shrinking/expanding it. , module Waterfall.Offset-, module Waterfall.Path.Common+-- | Paths in 3D space. , module Waterfall.Path-, module Waterfall.Revolution-, module Waterfall.Solids+-- | Two Dimensional Shapes.+, module Waterfall.TwoD.Shape+-- | Sweep a 2D `Shape` along a `Path`, constructing a `Solid`. , module Waterfall.Sweep-, module Waterfall.Transforms+-- | Construct a `Solid` of revolution from a `Path2D`.+, module Waterfall.Revolution+-- | Transforms for data types that exist in Two Dimensional space, like `Shape` and `Path2D`. , module Waterfall.TwoD.Transforms+-- | Paths in 2D space, can be built up into a `Shape`. , module Waterfall.TwoD.Path2D-, module Waterfall.TwoD.Shape+-- | Create a `Shape` from text, rendered using a specific `Font`. , module Waterfall.TwoD.Text+-- | 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.+, module Waterfall.Path.Common )where  import Waterfall.Booleans

@@ -1,46 +1,148 @@ module Waterfall.IO-(  writeSTL+( WaterfallIOException (..)+, WaterfallIOExceptionCause (..)+  -- * Solid Writers+, writeSolid+, writeSTL+, writeAsciiSTL , writeSTEP , writeGLTF , writeGLB+, writeOBJ+  -- * Solid Readers+  -- +  -- | Load a `Waterfall.Solid` from a file+  --+  -- At present, the "read*" functions do slightly less validation on the loaded solid +  -- than they arguably should  +  -- and may succeed when reading solids that may generate invalid geometry when processed+, readSolid+, readSTL+, readSTEP+, readGLTF+, readGLB+, readOBJ ) where   import Waterfall.Internal.Solid (Solid(..))+import qualified Waterfall.Internal.Remesh as Remesh import qualified OpenCascade.BRepMesh.IncrementalMesh as BRepMesh.IncrementalMesh import qualified OpenCascade.StlAPI.Writer as StlWriter+import qualified OpenCascade.StlAPI.Reader as StlReader import qualified OpenCascade.STEPControl.Writer as StepWriter import qualified OpenCascade.STEPControl.StepModelType as StepModelType+import qualified OpenCascade.STEPControl.Reader as STEPReader+import qualified OpenCascade.XSControl.Reader as XSControl.Reader+import qualified OpenCascade.IFSelect.ReturnStatus as IFSelect.ReturnStatus import qualified OpenCascade.TDocStd.Document as TDocStd.Document+import qualified OpenCascade.Message.Types as Message import qualified OpenCascade.Message.ProgressRange as Message.ProgressRange import qualified OpenCascade.TColStd.IndexedDataMapOfStringString as TColStd.IndexedDataMapOfStringString import qualified OpenCascade.RWGltf.CafWriter as RWGltf.CafWriter+import qualified OpenCascade.RWGltf.CafReader as RWGltf.CafReader+import qualified OpenCascade.RWObj.CafWriter as RWObj.CafWriter+import qualified OpenCascade.RWObj.CafReader as RWObj.CafReader+import qualified OpenCascade.RWMesh.Types as RWMesh+import qualified OpenCascade.RWMesh.CafReader as RWMesh.CafReader+import qualified OpenCascade.TDocStd.Types as TDocStd+import qualified OpenCascade.TColStd.Types as TColStd import qualified OpenCascade.XCAFDoc.DocumentTool as XCafDoc.DocumentTool import qualified OpenCascade.XCAFDoc.ShapeTool as XCafDoc.ShapeTool+import qualified OpenCascade.TopoDS.Types as TopoDS+import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape+import OpenCascade.Handle (Handle)+import OpenCascade.Inheritance (upcast) import Control.Monad.IO.Class (liftIO)-import Control.Monad (void, unless)-import System.IO (hPutStrLn, stderr)-import Waterfall.Internal.Finalizers (toAcquire)-import Data.Acquire+import Control.Monad (unless, when)+import Waterfall.Internal.Finalizers (toAcquire, fromAcquire)+import Data.Acquire ( Acquire, withAcquire )+import Foreign.Ptr (Ptr)+import Data.Char (toLower)+import System.FilePath (takeExtension)+import Control.Exception (Exception, throwIO) --- | Write a `Solid` to a (binary) STL file at a given path+-- | The type of exceptions thrown by IO actions defined in `Waterfall.IO`+data WaterfallIOException = +    WaterfallIOException +      { ioExceptionCause :: WaterfallIOExceptionCause+      , ioExceptionFilePath :: FilePath +      }+    deriving Show++instance Exception WaterfallIOException++-- | Reason for an IO action to have failed+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 +    FileError  +    -- | The contents of a file could not be converted into a `Waterfall.Solid`+    -- e.g the file did not contain a solid object+    | BadGeometryError+    -- | The `readSolid`/`writeSolid` functions could not infer the correct file format from a filepath+    | UnrecognizedFormatError +    deriving (Show, Eq)+++extensionToFormats :: String -> Maybe (Double -> FilePath -> Solid -> IO(), FilePath -> IO Solid)+extensionToFormats s =+    let ext = fmap toLower . takeExtension $ s +     in case ext of  +        ".stl" -> Just (writeSTL, readSTL)+        ".step" -> Just (const writeSTEP, readSTEP)+        ".gltf" -> Just (writeGLTF, readGLTF)+        ".glb" -> Just (writeGLB, readGLB)+        ".obj" -> Just (writeOBJ, readOBJ)+        _ -> Nothing++-- | Write a `Solid` to a file, work out the format from the file extension+-- +-- Errors if passed a filename with an unrecognized extension -- -- Because BRep representations of objects can store arbitrary precision curves,--- but STL files store triangulated surfaces, +-- but some of the supported file formats store triangulated surfaces,  -- this function takes a "deflection" argument used to discretize curves. -- -- The deflection is the maximum allowable distance between a curve and the generated triangulation.-writeSTL :: Double -> FilePath -> Solid -> IO ()-writeSTL linDeflection filepath (Solid ptr) = (`withAcquire` pure) $ do+writeSolid :: Double -> FilePath -> Solid -> IO ()+writeSolid res filepath = +    case extensionToFormats filepath of+        Just (writer, _) -> writer res filepath+        Nothing -> const $ throwIO (WaterfallIOException UnrecognizedFormatError filepath)++writeSTLAsciiOrBinary :: Bool -> Double -> FilePath -> Solid -> IO ()+writeSTLAsciiOrBinary asciiMode linDeflection filepath (Solid ptr) = (`withAcquire` pure) $ do     s <- toAcquire ptr     mesh <- BRepMesh.IncrementalMesh.fromShapeAndLinDeflection s linDeflection     liftIO $ BRepMesh.IncrementalMesh.perform mesh     writer <- StlWriter.new     liftIO $ do-            StlWriter.setAsciiMode writer False+            StlWriter.setAsciiMode writer asciiMode             res <- StlWriter.write writer s filepath-            unless res (hPutStrLn stderr ("failed to write " <> filepath))+            unless res (throwIO (WaterfallIOException FileError filepath))     return () +-- | Write a `Solid` to a (binary) STL file at a given path+--+-- Because BRep representations of objects can store arbitrary precision curves,+-- but STL files store triangulated surfaces, +-- this function takes a "deflection" argument used to discretize curves.+--+-- The deflection is the maximum allowable distance between a curve and the generated triangulation.+writeSTL :: Double -> FilePath -> Solid -> IO ()+writeSTL = writeSTLAsciiOrBinary False++-- | Write a `Solid` to an Ascii STL file at a given path+--+-- Because BRep representations of objects can store arbitrary precision curves,+-- but STL files store triangulated surfaces, +-- this function takes a "deflection" argument used to discretize curves.+--+-- The deflection is the maximum allowable distance between a curve and the generated triangulation.+writeAsciiSTL :: Double -> FilePath -> Solid -> IO ()+writeAsciiSTL = writeSTLAsciiOrBinary True+ -- | Write a `Solid` to a STEP file at a given path -- -- STEP files can be imported by [FreeCAD](https://www.freecad.org/)@@ -48,11 +150,13 @@ writeSTEP filepath (Solid ptr) = (`withAcquire` pure) $ do     s <- toAcquire ptr     writer <- StepWriter.new-    _ <- liftIO $ StepWriter.transfer writer s StepModelType.Asls True-    void . liftIO $ StepWriter.write writer filepath+    resTransfer <- liftIO $ StepWriter.transfer writer s StepModelType.Asls True+    unless (resTransfer == IFSelect.ReturnStatus.Done) (liftIO . throwIO $ WaterfallIOException BadGeometryError filepath)+    resWrite <- liftIO $ StepWriter.write writer filepath+    unless (resWrite == IFSelect.ReturnStatus.Done) (liftIO . throwIO $ WaterfallIOException FileError filepath) -writeGLTFOrGLB :: Bool -> Double -> FilePath -> Solid -> IO ()-writeGLTFOrGLB binary linDeflection filepath (Solid ptr) = (`withAcquire` pure) $ do+cafWriter :: (FilePath -> Ptr (Handle TDocStd.Document) -> Ptr TColStd.IndexedDataMapOfStringString -> Ptr Message.ProgressRange -> Acquire ()) -> Double -> FilePath -> Solid-> IO ()+cafWriter write linDeflection filepath (Solid ptr) = (`withAcquire` pure) $ do     s <- toAcquire ptr     mesh <- BRepMesh.IncrementalMesh.fromShapeAndLinDeflection s linDeflection     liftIO $ BRepMesh.IncrementalMesh.perform mesh@@ -62,19 +166,124 @@     _ <- XCafDoc.ShapeTool.addShape shapeTool s True True     meta <- TColStd.IndexedDataMapOfStringString.new     progress <- Message.ProgressRange.new-    writer <- RWGltf.CafWriter.new filepath binary-    liftIO $ RWGltf.CafWriter.perform writer doc meta progress-    return ()+    write filepath doc meta progress +writeGLTFOrGLB :: Bool -> Double -> FilePath -> Solid -> IO ()+writeGLTFOrGLB binary =+    let write filepath doc meta progress = do +            writer <- RWGltf.CafWriter.new filepath binary+            liftIO $ RWGltf.CafWriter.perform writer doc meta progress+    in cafWriter write+ -- | Write a `Solid` to a glTF file at a given path -- -- glTF, or Graphics Library Transmission Format is a JSON based format  -- used for three-dimensional scenes and models+--+-- Because BRep representations of objects can store arbitrary precision curves,+-- but glTF files store triangulated surfaces, +-- this function takes a "deflection" argument used to discretize curves.+--+-- The deflection is the maximum allowable distance between a curve and the generated triangulation. writeGLTF :: Double -> FilePath -> Solid -> IO () writeGLTF = writeGLTFOrGLB False  -- | Write a `Solid` to a glb file at a given path -- -- glb is the binary variant of the glTF file format+--+-- Because BRep representations of objects can store arbitrary precision curves,+-- but glTF files store triangulated surfaces, +-- this function takes a "deflection" argument used to discretize curves.+--+-- The deflection is the maximum allowable distance between a curve and the generated triangulation. writeGLB :: Double -> FilePath -> Solid -> IO () writeGLB = writeGLTFOrGLB True++-- | Write a `Solid` to an obj file at a given path+--+-- Wavefront OBJ is a simple ascii file format that stores geometric data.+--+-- Because BRep representations of objects can store arbitrary precision curves,+-- but obj files store triangulated surfaces, +-- this function takes a "deflection" argument used to discretize curves.+--+-- The deflection is the maximum allowable distance between a curve and the generated triangulation.+writeOBJ :: Double -> FilePath -> Solid -> IO ()+writeOBJ = +    let write filepath doc meta progress = do +            writer <- RWObj.CafWriter.new filepath+            liftIO $ RWObj.CafWriter.perform writer doc meta progress+    in cafWriter write++-- | Read a `Solid` from a file at a given path+-- +-- Throws an error if loading fails, or if it's unable to work out+-- the intended file format from the path+readSolid :: FilePath -> IO Solid+readSolid filepath = +    case extensionToFormats filepath of +        Nothing -> throwIO (WaterfallIOException UnrecognizedFormatError filepath)+        Just (_, reader) -> reader filepath++remeshOrThrow :: FilePath -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape)+remeshOrThrow filepath shape = do+    remeshed <- Remesh.remesh shape+    case remeshed of +        Just solid -> pure solid+        Nothing -> liftIO . throwIO $ WaterfallIOException BadGeometryError filepath++-- | Read a `Solid` from an STL file at a given path+readSTL :: FilePath -> IO Solid+readSTL filepath = fmap Solid . fromAcquire $ do+    shape <- TopoDS.Shape.new+    reader <- StlReader.new+    res <- liftIO $ StlReader.read reader shape filepath+    unless res $ liftIO . throwIO $ WaterfallIOException FileError filepath+    remeshOrThrow filepath shape++-- | Read a `Solid` from a STEP file at a given path+readSTEP :: FilePath -> IO Solid+readSTEP filepath = fmap Solid . fromAcquire $ do+    reader <- STEPReader.new+    status <- liftIO $ XSControl.Reader.readFile (upcast reader) filepath+    _ <- liftIO $ XSControl.Reader.transferRoots (upcast reader)+    shape <- XSControl.Reader.oneShape (upcast reader)+    unless (status == IFSelect.ReturnStatus.Done) (liftIO . throwIO $ WaterfallIOException FileError filepath)+    shapeIsNull <- liftIO $ TopoDS.Shape.isNull shape+    when shapeIsNull (liftIO . throwIO $ WaterfallIOException BadGeometryError filepath)+    return shape++cafReader :: Acquire (Ptr RWMesh.CafReader) -> FilePath -> IO Solid+cafReader mkReader filepath = fmap Solid . fromAcquire $ do+    reader <- mkReader+    doc <- TDocStd.Document.fromStorageFormat ""+    progress <- Message.ProgressRange.new+    _ <- liftIO $ RWMesh.CafReader.setDocument reader doc+    res <- liftIO $ RWMesh.CafReader.perform reader filepath progress+    unless res (liftIO . throwIO $ WaterfallIOException FileError filepath)+    remeshOrThrow filepath =<< RWMesh.CafReader.singleShape reader++-- | Read a `Solid` from a GLTF file at a given path+--+-- This should support reading both the GLTF (json) and GLB (binary) formats+readGLTF :: FilePath -> IO Solid+readGLTF  = cafReader $ do+    reader <- RWGltf.CafReader.new +    liftIO $ RWGltf.CafReader.setDoublePrecision reader True+    liftIO $ RWMesh.CafReader.setFileLengthUnit (upcast reader) 1+    return (upcast reader)++-- | Alias for `readGLTF`+readGLB :: FilePath -> IO Solid+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 +    liftIO $ RWObj.CafReader.setSinglePrecision reader False+    liftIO $ RWMesh.CafReader.setFileLengthUnit (upcast reader) 1+    return (upcast reader)

@@ -10,6 +10,7 @@ module Waterfall.Internal.Finalizers  ( unsafeFromAcquire , fromAcquire+, fromAcquireMay , toAcquire ) where @@ -30,6 +31,20 @@     release <- fromMaybe (pure ()) <$> unprotect releaseKey     liftIO $ addFinalizer v release     return v++    +-- | variant of `fromAcquire` which registers the finalizer on the _value_ in a `Maybe` +-- as opposed to the maybe itself +-- this is useful for wrapping IO actions that return the type `IO (Maybe a)` where the `Maybe` will often be finalized well before the value+fromAcquireMay :: Acquire (Maybe a) -> IO (Maybe a) +fromAcquireMay a = runResourceT $ do+    (releaseKey, v) <- allocateAcquire a+    release <- fromMaybe (pure ()) <$> unprotect releaseKey+    case v of+        Nothing -> liftIO $ Nothing <$ release+        Just v' -> do+            liftIO $ addFinalizer v' release+            return . Just $ v'  -- | Converting to a value in the `Data.Acquire.Acquire` monad, to a raw value. -- Analagous to calling `unsafePerformIO` to extract a value in the `IO` monad.

@@ -0,0 +1,127 @@+{-| +Module: Waterfall.Internal.Remesh++This code exists because the opencascade GLTF loading code generates "weird" BReps++The FreeCAD sourcecode describes this as follows:++> The glTF reader creates a compound of faces that only contains the triangulation+> but not the underlying surfaces. This leads to faces without boundaries.+> The triangulation is used to create a valid shape.++The practical result of this, seems to be that directly using an `OpenCascade.TopoDS.Shape` +loaded using `OpenCascade.RWGltf.CafReader` in most operations will lead to segmentation faults.++However, we can safely access the Triangulation of the Shape, construct Polygons from this+and then use BReps derived from these Polygons.++In this way, the `remesh` function produces a new Boundary Represenation from the Mesh of an `OpenCascade.TopoDS.Shape`++-}+module Waterfall.Internal.Remesh +( remesh +) where++import qualified OpenCascade.GP.Pnt as GP.Pnt+import qualified OpenCascade.TopoDS as TopoDS+import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape+import qualified OpenCascade.TopoDS.Compound as TopoDS.Compound+import qualified OpenCascade.TopExp.Explorer as TopExp.Explorer+import qualified OpenCascade.TopAbs.ShapeEnum as ShapeEnum+import qualified OpenCascade.TopAbs.Orientation as TopAbs.Orientation+import qualified OpenCascade.BRepBuilderAPI.Sewing as BRepBuilderAPI.Sewing+import qualified OpenCascade.BRepBuilderAPI.MakePolygon as BRepBuilderAPI.MakePolygon+import qualified OpenCascade.BRepBuilderAPI.MakeFace as BRepBuilderAPI.MakeFace+import qualified OpenCascade.BRepBuilderAPI.MakeSolid as BRepBuilderAPI.MakeSolid+import qualified OpenCascade.BRepBuilderAPI.MakeShape as BRepBuilderAPI.MakeShape+import qualified OpenCascade.BRep.Tool as BRep.Tool+import qualified OpenCascade.BRepLib as BRepLib+import qualified OpenCascade.TopoDS.Builder as TopoDS.Builder+import qualified OpenCascade.BRepMesh.IncrementalMesh as BRepMesh.IncrementalMesh+import qualified OpenCascade.Poly.Triangulation as Poly.Triangulation+import qualified OpenCascade.Poly.Triangle as Poly.Triangle+import qualified OpenCascade.TopLoc.Location as TopLoc.Location+import OpenCascade.Inheritance (upcast, unsafeDowncast)+import Foreign.Ptr (Ptr)+import Data.Acquire (Acquire)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad (when, unless, forM_, (<=<))+++checkNonNull:: MonadIO m => Ptr TopoDS.Shape -> m (Maybe (Ptr TopoDS.Shape))+checkNonNull shape = do+    isNull <- liftIO . TopoDS.Shape.isNull $ shape+    return $ if isNull +        then Nothing+        else Just shape++remesh :: Ptr TopoDS.Shape -> Acquire (Maybe (Ptr TopoDS.Shape))+remesh s = do++    let linDeflection = 0.01+    mesh <- BRepMesh.IncrementalMesh.fromShapeAndLinDeflection s linDeflection+    liftIO $ BRepMesh.IncrementalMesh.perform mesh++    builder <- TopoDS.Builder.new+    compound <- TopoDS.Compound.new+    liftIO $ TopoDS.Builder.makeCompound builder compound+    sewing <- BRepBuilderAPI.Sewing.new 1e-6 True True True False+    explorer <- TopExp.Explorer.new s ShapeEnum.Face+    +    let actionForEachFace :: Acquire ()+        actionForEachFace = do+            faceAsShape <- liftIO $ TopExp.Explorer.value explorer+            faceAsFace <- liftIO . unsafeDowncast $ faceAsShape+            loc <- TopLoc.Location.new+            orientation <- liftIO $ TopoDS.Shape.orientation faceAsShape+            trsf <- TopLoc.Location.toGPTrsf loc+            triangulation <- BRep.Tool.triangulation faceAsFace loc+            triCount <- liftIO $ Poly.Triangulation.nbTriangles triangulation+            forM_ [1..triCount] $ \i -> do+                triangle <- Poly.Triangulation.triangle triangulation i+                let p = (`GP.Pnt.transformed` trsf) <=< Poly.Triangulation.node triangulation <=< liftIO . Poly.Triangle.value triangle +                p1 <- p 1+                p2 <- p 2+                p3 <- p 3+                let pointsEqual a b = liftIO $ GP.Pnt.isEqual a b 0+                p12Coincident <- pointsEqual p1 p2 +                p13Coincident <- pointsEqual p1 p3+                p23Coincident <- pointsEqual p2 p3+                let anyPointsCoincident = p12Coincident || p13Coincident || p23Coincident+                unless anyPointsCoincident $ do+                    let makePolygon p1' p2' p3' = BRepBuilderAPI.MakePolygon.from3Pnts p1' p2' p3' True+                    polygon <- if orientation == TopAbs.Orientation.Reversed +                        then makePolygon p1 p3 p2+                        else makePolygon p1 p2 p3+                    polygonIsNull <- liftIO $ TopoDS.Shape.isNull (upcast polygon)+                    unless polygonIsNull $ do+                        makeFace <- BRepBuilderAPI.MakeFace.fromWire polygon False+                        newFace <- BRepBuilderAPI.MakeShape.shape (upcast makeFace)+                        faceIsNull <- liftIO $ TopoDS.Shape.isNull newFace+                        unless faceIsNull $ liftIO $ TopoDS.Builder.add builder (upcast compound) newFace ++    let go = do+            isMore <- liftIO $ TopExp.Explorer.more explorer+            when isMore $ do +                actionForEachFace+                liftIO $ TopExp.Explorer.next explorer+                go+    go+    liftIO $ BRepBuilderAPI.Sewing.load sewing (upcast compound)+    liftIO . BRepBuilderAPI.Sewing.perform $ sewing+    shape <- BRepBuilderAPI.Sewing.sewedShape sewing+    makeSolid <- BRepBuilderAPI.MakeSolid.new +    shapeAsShell <- liftIO $ unsafeDowncast shape+    liftIO $ BRepBuilderAPI.MakeSolid.add makeSolid shapeAsShell+    shapeAsSolid <- BRepBuilderAPI.MakeSolid.solid makeSolid+    maybeNotNull <- checkNonNull (upcast shapeAsSolid)+    case maybeNotNull of+        Nothing -> return Nothing+        Just _ -> do +            orientable <- liftIO $ BRepLib.orientClosedSolid (shapeAsSolid)+            if orientable +                then return . Just . upcast $ shapeAsSolid+                else return Nothing+            ++    

@@ -16,7 +16,6 @@ import Foreign.Ptr import Algebra.Lattice import Control.Monad.IO.Class (liftIO)-import Control.Monad (forM_) import qualified OpenCascade.TopoDS as TopoDS import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape import qualified OpenCascade.BRepAlgoAPI.Fuse as Fuse@@ -46,8 +45,8 @@  -- | print debug information about a Solid when it's evaluated  -- exposes the properties of the underlying OpenCacade.TopoDS.Shape-debug :: String -> Solid -> Solid-debug name (Solid ptr) = +debug :: Solid -> String+debug (Solid ptr) =      let          fshow :: Show a => IO a -> IO String          fshow = fmap show@@ -65,14 +64,10 @@             , ("convex", fshow . TopoDS.Shape.convex)             , ("nbChildren", fshow . TopoDS.Shape.nbChildren)             ]-    in Solid $ unsafeFromAcquire $ do+    in unsafeFromAcquire $ do         s <- toAcquire ptr-        liftIO $ do -            putStrLn name-            forM_ actions $ \(actionName, value) -> do-                putStrLn ("\t" <> actionName)-                putStrLn . ("\t\t" <>) =<< value s-        return s+        liftIO $ (`foldMap` actions) $ \(actionName, value) -> +                (return $ "\t" <> actionName <> "\t\t") <> value s <> (return "\n")  {-- -- TODO: this does not work, need to fix

@@ -10,8 +10,28 @@ import qualified OpenCascade.BRepOffset.Mode as Mode import qualified OpenCascade.GeomAbs.JoinType as GeomAbs.JoinType import qualified OpenCascade.BRepBuilderAPI.MakeSolid as MakeSolid+import qualified OpenCascade.TopoDS.Types as TopoDS+import qualified OpenCascade.TopExp.Explorer as TopExp.Explorer+import qualified OpenCascade.TopAbs.ShapeEnum as TopAbs.ShapeEnum+import Control.Monad (when)+import Foreign.Ptr (Ptr)+import Data.Acquire (Acquire) import Linear.Epsilon (nearZero) +combineShellsToSolid :: Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape)+combineShellsToSolid s = do+    explorer <- TopExp.Explorer.new s TopAbs.ShapeEnum.Shell+    makeSolid <- MakeSolid.new+    let go = do+            isMore <- liftIO $ TopExp.Explorer.more explorer+            when isMore $ do+                shell <- liftIO $ unsafeDowncast =<< TopExp.Explorer.value explorer+                liftIO $ MakeSolid.add makeSolid shell+                liftIO $ TopExp.Explorer.next explorer+                go+    go+    upcast <$> MakeSolid.solid makeSolid+ -- | Expand or contract a `Solid` by a certain amount. --  -- This seems to be relatively fragile on Sweeps/Prisms@@ -29,7 +49,4 @@     --liftIO $ MakeOffsetShape.performBySimple builder s value     liftIO $ MakeOffsetShape.performByJoin builder s value tolerance Mode.Skin False False GeomAbs.JoinType.Arc False      shell <- MakeShape.shape (upcast builder)-    shellBuilder <- MakeSolid.new-    liftIO $ MakeSolid.add shellBuilder =<< unsafeDowncast shell-    MakeShape.shape (upcast shellBuilder)-    +    combineShellsToSolid shell

@@ -8,6 +8,7 @@  import qualified Waterfall.TwoD.Internal.Shape as Shape import Waterfall.Internal.Finalizers (toAcquire, fromAcquire, unsafeFromAcquire)+import Waterfall.IO (WaterfallIOException (..), WaterfallIOExceptionCause (FileError)) import qualified OpenCascade.GP.Ax3 as GP.Ax3 import qualified OpenCascade.Font.BRepFont as BRepFont import qualified OpenCascade.Font.BRepTextBuilder as BRepTextBuilder@@ -16,6 +17,7 @@ import Foreign.Ptr  import Control.Monad (unless) import OpenCascade.Font.FontAspect (FontAspect (..))+import Control.Exception (throwIO)  newtype Font = Font { rawFont :: Ptr BRepFont.BRepFont } @@ -24,7 +26,7 @@ fontFromPath fontpath size = do     bRepFont <- fromAcquire $ BRepFont.new     fontOk <- BRepFont.initFromPathAndSize bRepFont fontpath size-    unless (fontOk) $ error ("Unable to initialize font from filepath: " <> fontpath)+    unless (fontOk) $ throwIO (WaterfallIOException FileError fontpath)     return $ Font bRepFont  -- | Create a font from a system font name, aspect, and size@@ -32,7 +34,7 @@ fontFromSystem name aspect size = do     bRepFont <- fromAcquire $ BRepFont.new     fontOk <- BRepFont.initFromNameAspectAndSize bRepFont name aspect size-    unless (fontOk) $ error ("Unable to initialize system font with name: " <> name <> ", and aspect" <> show aspect)+    unless (fontOk) $ throwIO $ WaterfallIOException FileError (name <> "::" <> show aspect)     return $ Font bRepFont  -- | Render text, using the font from the provided filepath, at a given size.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           waterfall-cad-version:        0.2.1.0+version:        0.2.2.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@@ -38,6 +38,7 @@       Waterfall.Internal.Finalizers       Waterfall.Internal.FromOpenCascade       Waterfall.Internal.Path+      Waterfall.Internal.Remesh       Waterfall.Internal.Solid       Waterfall.IO       Waterfall.Offset@@ -60,10 +61,11 @@   ghc-options: -Wall -Werror=compat -Werror=identities -Werror=incomplete-record-updates -Werror=incomplete-uni-patterns -Werror=missing-home-modules -Werror=missing-export-lists -Werror=partial-fields -Werror=redundant-constraints -optc -Werror-implicit-function-declaration   build-depends:       base >=4.7 && <5+    , filepath >=1.4 && <1.6     , lattices >=2.0 && <3     , lens ==5.*     , linear >=1.21 && <2-    , opencascade-hs >=0.2.1.0 && <0.3+    , opencascade-hs >=0.2.2.0 && <0.3     , primitive >=0.7 && <0.10     , resourcet >=1.2 && <1.4   default-language: Haskell2010