waterfall-cad 0.6.1.0 → 0.6.2.0

raw patch · 6 files changed

+104/−6 lines, 6 filesdep ~opencascade-hsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: opencascade-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• src/Waterfall/Internal/Edges.hs +44/−1
• src/Waterfall/Path.hs +10/−0
• src/Waterfall/Path/Common.hs +32/−2
• src/Waterfall/TwoD/Path2D.hs +11/−1
• waterfall-cad.cabal +2/−2

@@ -8,6 +8,11 @@  ## Unreleased +## 0.6.2.0++- Added `Waterfall.Path.Common.pathLength`, `Waterfall.Path.pathLength3D` and `Waterfall.TwoD.Path2D.pathLength2D`+- Added `Waterfall.Path.Common.takePathFraction`, `Waterfall.Path.takePathFraction3D` and `Waterfall.TwoD.Path2D.takePathFraction2D`+ ## 0.6.1.0  ### Added 

@@ -14,6 +14,8 @@ , joinWires , splitWires , edgeToWire+, wireLength+, truncateWire ) where  import qualified OpenCascade.TopoDS as TopoDS@@ -28,6 +30,10 @@ import qualified OpenCascade.BRepLib as BRepLib import OpenCascade.GeomAbs.Shape as GeomAbs.Shape import Waterfall.Internal.FromOpenCascade (gpPntToV3, gpVecToV3)+import qualified OpenCascade.BRepAdaptor.Curve as BRepAdaptor.Curve+import qualified OpenCascade.GCPnts.AbscissaPoint as AbscissaPoint+import qualified OpenCascade.GProp.GProps as GProps+import qualified OpenCascade.BRepGProp as BRepGProp import Data.Acquire import Control.Monad.IO.Class (liftIO) import Linear (V3 (..), distance, normalize, nearZero)@@ -244,8 +250,45 @@     makeSegment  buildEdgeCurve3D :: Ptr TopoDS.Edge -> Acquire (Ptr TopoDS.Edge)-buildEdgeCurve3D edge = do +buildEdgeCurve3D edge = do     edge' <- (liftIO . unsafeDowncast) =<< TopoDS.Shape.copy (upcast edge)     _ <- liftIO $ BRepLib.buildCurve3d edge' 1e-5 GeomAbs.Shape.C1 14 0     return edge'++shapeLength :: Ptr TopoDS.Shape -> IO Double+shapeLength shape = (`with` pure) $ do+    gProp <- GProps.new+    liftIO $ BRepGProp.linearProperties shape gProp False False+    liftIO $ GProps.mass gProp++edgeLength :: Ptr TopoDS.Edge -> IO Double+edgeLength = shapeLength . upcast++wireLength :: Ptr TopoDS.Wire -> IO Double+wireLength = shapeLength . upcast++truncateWire :: Double -> Ptr TopoDS.Wire -> Acquire (Ptr TopoDS.Wire)+truncateWire targetLength wire = do+    explorer <- WireExplorer.fromWire wire+    builder <- MakeWire.new+    let go remaining = do+            more <- liftIO $ WireExplorer.more explorer+            when (more && not (nearZero remaining)) $ do+                edge <- liftIO $ WireExplorer.current explorer+                len <- liftIO $ edgeLength edge+                if len <= remaining+                    then do+                        liftIO $ MakeWire.addEdge builder edge+                        liftIO $ WireExplorer.next explorer+                        go (remaining - len)+                    else do+                        curve <- BRep.Tool.curve edge+                        firstP <- liftIO $ BRep.Tool.curveParamFirst edge+                        adaptor <- BRepAdaptor.Curve.fromEdge edge+                        absPnt <- AbscissaPoint.fromCurveAbscissaAndParam adaptor remaining firstP+                        cutParam <- liftIO $ AbscissaPoint.parameter absPnt+                        trimmedEdge <- MakeEdge.fromCurveAndParameters curve firstP cutParam+                        liftIO $ MakeWire.addEdge builder trimmedEdge+    go targetLength+    MakeWire.wire builder 

@@ -22,6 +22,8 @@ , reversePath3D , splice3D , splitPath3D+, pathLength3D+, takePathFraction3D ) where  import Waterfall.Internal.Path (Path(..))@@ -102,3 +104,11 @@ -- | `splitPath` with the type fixed to `Path` splitPath3D :: Path -> [Path] splitPath3D = splitPath++-- | `pathLength` with the type fixed to `Path`+pathLength3D :: Path -> Double+pathLength3D = pathLength++-- | `takePathFraction` with the type fixed to `Path`+takePathFraction3D :: Double -> Path -> Path+takePathFraction3D = takePathFraction

@@ -26,6 +26,8 @@ , closeLoop , reversePath , splitPath+, pathLength+, takePathFraction ) where import Data.Acquire import qualified OpenCascade.TopoDS as TopoDS@@ -36,7 +38,7 @@ import Waterfall.TwoD.Internal.Path2D (Path2D (..)) import Waterfall.Internal.Finalizers (unsafeFromAcquire, toAcquire, unsafeFromAcquireT) import Waterfall.Internal.FromOpenCascade (gpPntToV3)-import Waterfall.Internal.Edges (wireEndpoints, reverseWire, splitWires)+import Waterfall.Internal.Edges (wireEndpoints, reverseWire, splitWires, wireLength, truncateWire) import Control.Arrow (second) import Data.Foldable (foldl') import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire@@ -244,12 +246,40 @@         ComplexRawPath r -> fromWire . reverseWire $ r         _ -> p --- | Break a path appart at any "non smooth" point+-- | Break a path apart at any "non smooth" point splitPath :: (AnyPath point path) => path -> [path] splitPath p =      case deconstructPath p of          ComplexRawPath r -> fmap (reconstructPath . ComplexRawPath) . unsafeFromAcquireT . splitWires $ r         _ -> [p]++-- | Measure a path+pathLength :: AnyPath point path => path -> Double+pathLength p =+    case deconstructPath p of+        ComplexRawPath r -> unsafeFromAcquire $ liftIO . wireLength =<< toAcquire r+        _ -> 0++-- | Truncate a path to a fraction of its total length.+--+-- The fraction is clamped to the range [0, 1].+-- A value of 0 (or less) returns a single point at the start of the path,+-- a value of 1 (or greater) returns the original path.+takePathFraction :: forall point path. AnyPath point path => Double -> path -> path+takePathFraction fraction p+    | fraction >= 1 = p+    | fraction <= 0 =+        case pathEndpoints p of+            Just (s, _) -> reconstructPath . SinglePointRawPath $ pointToV3 (Proxy :: Proxy path) s+            Nothing -> p+    | otherwise =+        case deconstructPath p of+            ComplexRawPath r -> fromWire $ do+                wire <- toAcquire r+                totalLength <- liftIO $ wireLength wire+                let targetLength = fraction * totalLength+                truncateWire targetLength wire+            _ -> p  instance AnyPath (V3 Double) Path where     reconstructPath :: RawPath -> Path

@@ -27,7 +27,9 @@ , reversePath2D , splice2D , splitPath2D-) where +, pathLength2D+, takePathFraction2D+) where  import Waterfall.TwoD.Internal.Path2D (Path2D(..)) import Waterfall.TwoD.Transforms (rotate2D)@@ -159,3 +161,11 @@ -- | `splitPath` with the type fixed to `Path2D` splitPath2D :: Path2D -> [Path2D] splitPath2D = splitPath++-- | `pathLength` with the type fixed to `Path`+pathLength2D :: Path2D -> Double+pathLength2D = pathLength++-- | `takePathFraction` with the type fixed to `Path2D`+takePathFraction2D :: Double -> Path2D -> Path2D+takePathFraction2D = takePathFraction

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           waterfall-cad-version:        0.6.1.0+version:        0.6.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@@ -71,7 +71,7 @@     , lattices >=2.0 && <3     , lens ==5.*     , linear >=1.21 && <2-    , opencascade-hs >=0.6.1.0 && <0.7+    , opencascade-hs >=0.6.2.0 && <0.7     , primitive >=0.7 && <0.10     , resourcet >=1.2 && <1.4   default-language: Haskell2010