waterfall-cad 0.6.0.0 → 0.6.0.1
raw patch · 5 files changed
+85/−44 lines, 5 filesdep ~opencascade-hsPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependency ranges changed: opencascade-hs
API changes (from Hackage documentation)
+ Waterfall.Fillet: whenNearlyEqual :: Epsilon a => Lens' point a -> r -> (point, point) -> Maybe r
Files
- CHANGELOG.md +10/−1
- src/Waterfall/Fillet.hs +29/−2
- src/Waterfall/Transforms.hs +32/−29
- src/Waterfall/TwoD/Shape.hs +12/−10
- waterfall-cad.cabal +2/−2
CHANGELOG.md view
@@ -6,8 +6,17 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). - ## Unreleased++## 0.6.0.1++### Added++- Added `whenNearlyEqual` to `Waterfall.Fillet` to make writing conditional Fillets easier++### Fixed++- Workaround for an issue where calling `scale` with a uniform scale vector produced invalid geometry ## 0.6.0.0
src/Waterfall/Fillet.hs view
@@ -1,10 +1,21 @@+{-# LANGUAGE RankNTypes #-} module Waterfall.Fillet-( roundFillet+(+ -- * Rounds+-- | Fillet that adds radiused faces that are tangent to the two faces either side of an edge.+-- +-- Sometimes, it may not be possible to construct a fillet because there is not enough space next to one of the fillet edges,+-- Or because the geometry is too complicated for the fillet algorithm.+ roundFillet , roundConditionalFillet , roundIndexedConditionalFillet+-- * Chamfers+-- | Adds flat faces at a constant angle to the two faces either side of an edge. , chamfer , conditionalChamfer , indexedConditionalChamfer+-- * Utility Methods+, whenNearlyEqual ) where import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)@@ -21,7 +32,8 @@ import Control.Monad.IO.Class (liftIO) import OpenCascade.Inheritance (upcast, unsafeDowncast) import Linear.V3 (V3 (..))-+import Linear.Epsilon +import Control.Lens (Lens', (^.)) 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@@ -104,3 +116,18 @@ 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.+-- +-- This can be used in combination with `roundConditionalFillet`/`conditionalChamfer`.+--+-- Selecting only horizontal edges:+--+-- > roundConditionalFillet (whenNearlyEqual _z 2)+--+-- Selecting only vertical edges:+--+-- > roundConditionalFillet (whenNearlyEqual _xy 2)+whenNearlyEqual :: Epsilon a => Lens' point a -> r -> (point, point) -> Maybe r+whenNearlyEqual l res (s, e)+ | nearZero ((s ^. l) - (e ^. l)) = Just res+ | otherwise = Nothing
src/Waterfall/Transforms.hs view
@@ -55,13 +55,11 @@ trsf <- mkTrsf BRepBuilderAPI.Transform.transform solid trsf True -fromGTrsfSolid :: Acquire (Maybe (Ptr GP.GTrsf)) -> Solid -> Solid+fromGTrsfSolid :: Acquire (Ptr GP.GTrsf) -> Solid -> Solid fromGTrsfSolid mkTrsf s = solidFromAcquire $ do solid <- acquireSolid s- trsfMay <- mkTrsf - case trsfMay of- Just trsf -> BRepBuilderAPI.GTransform.gtransform solid trsf True - Nothing -> pure solid+ trsf <- mkTrsf + BRepBuilderAPI.GTransform.gtransform solid trsf True fromTrsfPath :: (V3 Double -> V3 Double) -> Acquire (Ptr GP.Trsf) -> Path -> Path fromTrsfPath _ mkTrsf (Path (ComplexRawPath p)) = Path . ComplexRawPath . unsafeFromAcquire $ do @@ -71,29 +69,29 @@ fromTrsfPath f _ (Path (SinglePointRawPath v)) = Path . SinglePointRawPath . f $ v fromTrsfPath _ _ (Path EmptyRawPath) = Path EmptyRawPath -fromGTrsfPath :: (V3 Double -> V3 Double) -> Acquire (Maybe (Ptr GP.GTrsf)) -> Path -> Path+fromGTrsfPath :: (V3 Double -> V3 Double) -> Acquire (Ptr GP.GTrsf) -> Path -> Path fromGTrsfPath _ mkTrsf (Path (ComplexRawPath p)) = Path . ComplexRawPath . unsafeFromAcquire $ do path <- toAcquire p- trsfMay <- mkTrsf - case trsfMay of- Just trsf -> (liftIO . unsafeDowncast) =<< BRepBuilderAPI.GTransform.gtransform (upcast path) trsf True - Nothing -> pure path+ trsf <- mkTrsf + (liftIO . unsafeDowncast) =<< BRepBuilderAPI.GTransform.gtransform (upcast path) trsf True fromGTrsfPath f _ (Path (SinglePointRawPath v)) = Path . SinglePointRawPath . f $ v fromGTrsfPath _ _ (Path EmptyRawPath) = Path EmptyRawPath --scaleTrsf :: V3 Double -> Acquire (Maybe (Ptr GP.GTrsf))+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 pure Nothing- else do- trsf <- 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 . Just $ trsf+ then Nothing+ else + if x == y && y == z+ then Just . Left $ uScaleTrsf x+ else Just . Right $ do+ trsf <- 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 uScaleTrsf :: Double -> Acquire (Ptr GP.Trsf) uScaleTrsf factor = do@@ -128,9 +126,10 @@ GP.Trsf.setMirrorAboutAx2 trsf axis return trsf -matrixGTrsf :: M34 Double -> Acquire (Maybe (Ptr GP.GTrsf))-matrixGTrsf (V3 (V4 1 0 0 0) (V4 0 1 0 0) (V4 0 0 1 0)) = pure Nothing-matrixGTrsf (V3 (V4 v11 v12 v13 v14) (V4 v21 v22 v23 v24) (V4 v31 v32 v33 v34)) = do+matrixGTrsf :: M34 Double -> Maybe (Either (Acquire (Ptr GP.Trsf)) (Acquire (Ptr GP.GTrsf)))+matrixGTrsf (V3 (V4 1 0 0 0) (V4 0 1 0 0) (V4 0 0 1 0)) = Nothing+matrixGTrsf (V3 (V4 x 0 0 0) (V4 0 y 0 0) (V4 0 0 z 0)) | x == y && y == z = Just . Left . uScaleTrsf $ x+matrixGTrsf (V3 (V4 v11 v12 v13 v14) (V4 v21 v22 v23 v24) (V4 v31 v32 v33 v34)) = Just . Right $ do trsf <- GP.GTrsf.new liftIO $ do GP.GTrsf.setValue trsf 1 1 v11@@ -146,14 +145,14 @@ GP.GTrsf.setValue trsf 3 3 v33 GP.GTrsf.setValue trsf 3 4 v34 GP.GTrsf.setForm trsf- return . pure $ trsf+ return trsf instance Transformable Solid where matTransform :: M34 Double -> Solid -> Solid- matTransform = fromGTrsfSolid . matrixGTrsf + matTransform = maybe id (either fromTrsfSolid fromGTrsfSolid) . matrixGTrsf scale :: V3 Double -> Solid -> Solid- scale = fromGTrsfSolid . scaleTrsf+ scale = maybe id (either fromTrsfSolid fromGTrsfSolid) . scaleTrsf uScale :: Double -> Solid -> Solid uScale = fromTrsfSolid . uScaleTrsf@@ -169,10 +168,14 @@ instance Transformable Path where matTransform :: M34 Double -> Path -> Path- matTransform m = fromGTrsfPath (matTransform m) (matrixGTrsf m)+ matTransform m = + let transformPnt = matTransform m+ in maybe id (either (fromTrsfPath transformPnt) (fromGTrsfPath transformPnt)) $ matrixGTrsf m scale :: V3 Double -> Path -> Path- scale s = fromGTrsfPath (scale s) (scaleTrsf s)+ scale s = + let transformPnt = scale s + in maybe id (either (fromTrsfPath transformPnt) (fromGTrsfPath transformPnt)) $ scaleTrsf s uScale :: Double -> Path -> Path uScale s = fromTrsfPath (uScale s) (uScaleTrsf s)
src/Waterfall/TwoD/Shape.hs view
@@ -71,14 +71,16 @@ -- -- Ill-defined when n <= 2 unitPolygon :: Integer -> Shape-unitPolygon n = - let n' = fromIntegral n- points = [- rotate2D (2 * pi * fromIntegral i / n') (unit _x)- | i <- [0..n]- ]- paths = mconcat [- line a b- | (a, b) <- zip points (tail points)- ]+unitPolygon n + | n <= 2 = error "Polygon with <= 2 points is ill defined"+ | otherwise = + let n' = fromIntegral n+ points = [+ rotate2D (2 * pi * fromIntegral i / n') (unit _x)+ | i <- [0..n]+ ]+ paths = mconcat [+ line a b+ | (a, b) <- zip points (drop 1 points)+ ] in makeShape paths
waterfall-cad.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: waterfall-cad-version: 0.6.0.0+version: 0.6.0.1 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.0.0 && <0.7+ , opencascade-hs >=0.6.0.1 && <0.7 , primitive >=0.7 && <0.10 , resourcet >=1.2 && <1.4 default-language: Haskell2010