waterfall-cad 0.1.0.0 → 0.1.1.0

raw patch · 7 files changed

+117/−7 lines, 7 filesdep ~opencascade-hsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: opencascade-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• src/Waterfall.hs +2/−0
• src/Waterfall/Internal/Edges.hs +17/−0
• src/Waterfall/Offset.hs +31/−0
• src/Waterfall/Sweep.hs +25/−5
• src/Waterfall/TwoD/Shape.hs +27/−0
• waterfall-cad.cabal +3/−2

@@ -6,7 +6,19 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). + ## Unreleased++## 0.1.1.0 - 2023-12-12 ++### Added ++- Add Waterfall.Offset, offsetting an object by a certain amount+- Add `unitCircle`, `unitSquare` and `centeredSquare` to `Waterfall.TwoD.Shape`++### Fixed++- Correctly rotate and translate endcaps to the `Path` in a `sweep`  ## 0.1.0.0 - 2023-12-05  

@@ -3,6 +3,7 @@ , module Waterfall.Booleans.Operators , module Waterfall.Fillet , module Waterfall.IO+, module Waterfall.Offset , module Waterfall.Path.Common , module Waterfall.Path , module Waterfall.Revolution@@ -19,6 +20,7 @@ import Waterfall.Booleans.Operators import Waterfall.Fillet import Waterfall.IO+import Waterfall.Offset import Waterfall.Path.Common import Waterfall.Path import Waterfall.Revolution

@@ -2,6 +2,7 @@ ( gpPntToV3 , edgeEndpoints , wireEndpoints+, wireTangent ) where  import qualified OpenCascade.TopoDS as TopoDS@@ -14,11 +15,15 @@ import Control.Monad.IO.Class (liftIO) import Linear (V3 (..)) import Foreign.Ptr+import qualified OpenCascade.GP.Vec as GP.Vec   gpPntToV3 :: Ptr GP.Pnt -> IO (V3 Double) gpPntToV3 pnt = V3 <$> GP.Pnt.getX pnt <*> GP.Pnt.getY pnt <*> GP.Pnt.getZ pnt +gpVecToV3 :: Ptr GP.Vec -> IO (V3 Double)+gpVecToV3 vec = V3 <$> GP.Vec.getX vec <*> GP.Vec.getY vec <*> GP.Vec.getZ vec+ edgeEndpoints :: Ptr TopoDS.Edge -> IO (V3 Double, V3 Double) edgeEndpoints e = (`with` pure) $ do     curve <- BRep.Tool.curve e@@ -42,3 +47,15 @@                 else pure e'     e <- runToEnd     return (s, e)+++edgeTangent :: Ptr TopoDS.Edge -> IO (V3 Double)+edgeTangent e = (`with` pure) $ do+    curve <- BRep.Tool.curve e+    p1 <- liftIO . BRep.Tool.curveParamFirst $ e+    liftIO . gpVecToV3 =<< Geom.Curve.dn curve p1 1++wireTangent :: Ptr TopoDS.Wire -> IO (V3 Double)+wireTangent wire = with (WireExplorer.fromWire wire) $ \explorer -> do+    v1 <- WireExplorer.current explorer+    edgeTangent v1

@@ -0,0 +1,31 @@+module Waterfall.Offset +( offset+) where ++import Waterfall.Internal.Solid (Solid (..))+import qualified OpenCascade.BRepOffsetAPI.MakeOffsetShape as MakeOffsetShape+import Control.Monad.IO.Class (liftIO)+import OpenCascade.Inheritance (SubTypeOf(upcast), unsafeDowncast)+import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape+import qualified OpenCascade.BRepOffset.Mode as Mode+import qualified OpenCascade.GeomAbs.JoinType as GeomAbs.JoinType+import qualified OpenCascade.BRepBuilderAPI.MakeSolid as MakeSolid++-- | Expand or contract a `Solid` by a certain amount.+-- +-- This seems to be relatively fragile on Sweeps/Prisms+-- (as in, may fail to produce a result)+offset :: Double    -- ^ Amount to offset by, positive values expand, negative values contract+    -> Double       -- ^ Tolerance, this can be relatively small+    -> Solid        -- ^ the `Solid` to offset +    -> Solid+offset value tolerance (Solid run) = Solid $ do+    builder <- MakeOffsetShape.new+    s <- run +    --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)+    

@@ -4,19 +4,39 @@  import Waterfall.Internal.Solid (Solid (..)) import Waterfall.Internal.Path (Path (..))+import Waterfall.Internal.Edges (wireTangent, wireEndpoints)+import Waterfall.Transforms (rotate, translate) import Waterfall.TwoD.Internal.Shape (Shape (..)) import qualified OpenCascade.BRepOffsetAPI.MakePipe as MakePipe import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape import OpenCascade.Inheritance (upcast)+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 Data.Acquire (Acquire) +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)+            then pure face+            else+                let axis = if nearZero (vn + z) then unit _x else cross vn z+                    angle = acos (dot vn z) +                in runSolid . rotate axis angle . Solid . pure $ face ++positionFace :: V3 Double -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape)+positionFace p = runSolid . translate p . Solid . pure+ -- | Sweep a 2D `Shape` along a `Path`, constructing a `Solid`--- --- I may still need to make some tweaks to the alignment of the `Shape` and the `Path`.--- This will likely impact the shapes that are generated when the start point of the `Path` --- is not parallel to the z axis. sweep :: Path -> Shape -> Solid sweep (Path runThePath) (Shape runTheShape) = Solid $ do     path <- runThePath     shape <- runTheShape-    builder <- MakePipe.fromWireAndShape path shape+    tangent <- liftIO $ wireTangent path+    (start,_)  <- liftIO $ wireEndpoints path+    adjustedFace <- positionFace start =<< rotateFace tangent shape+    builder <- MakePipe.fromWireAndShape path adjustedFace     MakeShape.shape (upcast builder)

@@ -1,15 +1,42 @@ module Waterfall.TwoD.Shape ( Shape , fromPath+, unitCircle+, unitSquare+, centeredSquare ) where  import Waterfall.TwoD.Internal.Shape (Shape (..)) import Waterfall.TwoD.Internal.Path2D (Path2D (..))+import Waterfall.TwoD.Transforms (translate2D) import qualified OpenCascade.BRepBuilderAPI.MakeFace as MakeFace import OpenCascade.Inheritance (upcast)+import Linear (unit, _x, _y, zero, V2 (..))+import Waterfall.Path.Common (pathFrom, arcViaTo, lineTo)  -- | Construct a 2D Shape from a closed path  fromPath :: Path2D -> Shape fromPath (Path2D run)= Shape $ do     p <- run     upcast <$> (MakeFace.face =<< MakeFace.fromWire p False)++-- | Circle with radius 1, centered on the origin+unitCircle :: Shape+unitCircle = fromPath $ pathFrom (unit _x)+                [ arcViaTo (unit _y) (negate $ unit _x)+                , arcViaTo (negate $ unit _y) (unit _x)+                ]++-- | Square with side length of 1, one vertex on the origin, another on \( (1, 1) \)+unitSquare :: Shape+unitSquare =+    fromPath $ pathFrom zero+        [ lineTo (unit _x)+        , lineTo (V2 1 1)+        , lineTo (unit _y)+        , lineTo zero+        ]++-- | Square with side length of 1, centered on the origin+centeredSquare :: Shape+centeredSquare = translate2D (V2 (-0.5) (-0.5)) unitSquare

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           waterfall-cad-version:        0.1.0.0+version:        0.1.1.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@@ -36,6 +36,7 @@       Waterfall.Internal.Path       Waterfall.Internal.Solid       Waterfall.IO+      Waterfall.Offset       Waterfall.Path       Waterfall.Path.Common       Waterfall.Revolution@@ -58,6 +59,6 @@     , lattices >=2.0 && <3     , lens ==5.*     , linear >=1.21 && <2-    , opencascade-hs >=0.1.0.0 && <0.2+    , opencascade-hs >=0.1.1.0 && <0.2     , resourcet >=1.2 && <1.4   default-language: Haskell2010