waterfall-cad 0.6.0.1 → 0.6.1.0
raw patch · 5 files changed
+165/−8 lines, 5 filesdep ~opencascade-hsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: opencascade-hs
API changes (from Hackage documentation)
+ Waterfall.Internal.Remesh: makeSolidFromShell :: Ptr Shape -> Acquire (Maybe (Ptr Solid))
+ Waterfall.Solids: dodecahedron :: Solid
+ Waterfall.Solids: icosahedron :: Solid
+ Waterfall.Solids: octahedron :: Solid
+ Waterfall.Solids: tetrahedron :: Solid
+ Waterfall.Solids: torus :: Double -> Double -> Solid
Files
- CHANGELOG.md +11/−0
- src/Waterfall/Internal/Remesh.hs +1/−0
- src/Waterfall/Revolution.hs +2/−3
- src/Waterfall/Solids.hs +149/−3
- waterfall-cad.cabal +2/−2
CHANGELOG.md view
@@ -8,6 +8,17 @@ ## Unreleased +## 0.6.1.0++### Added ++- Added `Waterfall.Solids.torus`+- Added Platonic Solids:+ - `Waterfall.Solids.tetrahedron`+ - `Waterfall.Solids.octahedron`+ - `Waterfall.Solids.icosahedron`+ - `Waterfall.Solids.dodecahedron`+ ## 0.6.0.1 ### Added
src/Waterfall/Internal/Remesh.hs view
@@ -20,6 +20,7 @@ -} module Waterfall.Internal.Remesh ( remesh +, makeSolidFromShell ) where import qualified OpenCascade.GP.Pnt as GP.Pnt
src/Waterfall/Revolution.hs view
@@ -2,7 +2,7 @@ ( revolution ) where -import Waterfall.Internal.Solid (Solid (..), solidFromAcquire)+import Waterfall.Internal.Solid (Solid (..), solidFromAcquire, emptySolid) import Waterfall.TwoD.Internal.Path2D (Path2D (..)) import Waterfall.Internal.Finalizers (toAcquire) import qualified OpenCascade.BRepPrimAPI.MakeRevol as MakeRevol@@ -14,7 +14,6 @@ import Control.Monad.IO.Class (liftIO) import Linear (unit, _x) import Waterfall.Internal.Path.Common (RawPath(..))-import qualified Waterfall.Solids as Solids -- | Construct a `Solid` of revolution from a `Path2D`. --@@ -31,4 +30,4 @@ solidBuilder <- MakeSolid.new liftIO $ MakeSolid.add solidBuilder =<< unsafeDowncast shell MakeShape.shape (upcast solidBuilder)-revolution _ = Solids.emptySolid+revolution _ = emptySolid
src/Waterfall/Solids.hs view
@@ -8,6 +8,11 @@ , unitCylinder , centeredCylinder , unitCone+, torus+, tetrahedron+, octahedron+, dodecahedron+, icosahedron , prism , volume , centerOfMass@@ -18,18 +23,29 @@ import Waterfall.Internal.Solid (Solid (..), solidFromAcquire, acquireSolid, emptySolid) import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire) import Waterfall.TwoD.Internal.Shape (rawShape)+import Waterfall.Internal.ToOpenCascade (v3ToVertex) import Waterfall.Internal.FromOpenCascade (gpPntToV3)-import Waterfall.Transforms (translate)+import Waterfall.Internal.Remesh (makeSolidFromShell)+import Waterfall.Transforms (translate, rotate) import qualified Waterfall.TwoD.Shape as TwoD.Shape+import qualified OpenCascade.BRepBuilderAPI.MakeShape as MakeShape+import qualified OpenCascade.BRepBuilderAPI.MakeEdge as MakeEdge+import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire+import qualified OpenCascade.BRepBuilderAPI.MakeFace as MakeFace+import qualified OpenCascade.BRepBuilderAPI.Sewing as BRepBuilderAPI.Sewing+import qualified OpenCascade.TopoDS as TopoDS+import qualified OpenCascade.TopoDS.Compound as TopoDS.Compound+import qualified OpenCascade.TopoDS.Builder as TopoDS.Builder import qualified OpenCascade.BRepPrimAPI.MakeBox as MakeBox import qualified OpenCascade.BRepPrimAPI.MakeSphere as MakeSphere import qualified OpenCascade.BRepPrimAPI.MakeCylinder as MakeCylinder import qualified OpenCascade.BRepPrimAPI.MakeCone as MakeCone+import qualified OpenCascade.BRepPrimAPI.MakeTorus as MakeTorus import qualified OpenCascade.GProp.GProps as GProps import qualified OpenCascade.BRepGProp as BRepGProp import qualified OpenCascade.GP as GP-import Control.Lens ((^.))-import Linear (V3 (..), unit, _x, _y, _z, (^*))+import Control.Lens ((^.), (&), (.~))+import Linear (V3 (..), V2 (..), unit, _x, _y, _z, _xy, _yz, _zx, (^*), (*^), unangle, zero) import qualified OpenCascade.GP.Pnt as GP.Pnt import qualified OpenCascade.GP.Vec as GP.Vec import qualified OpenCascade.GP.Dir as GP.Dir@@ -82,6 +98,21 @@ 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+-- (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 )+ -> Solid+torus major minor = + solidFromAcquire+ $ MakeShape.shape + . Inheritance.upcast + =<< MakeTorus.fromRadii major minor+ -- | A cone -- With a point at the origin -- and a circular face with Radius 1, centered on \( (0, 0, 1) \)@@ -97,6 +128,121 @@ 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+ verts <- traverse v3ToVertex pnts+ edges <- traverse (uncurry MakeEdge.fromVertices) $ zip verts (drop 1 (cycle verts))+ wireBuilder <- MakeWire.new+ _ <- liftIO $ traverse (MakeWire.addEdge wireBuilder) edges+ wire <- MakeWire.wire wireBuilder+ -- passing True here forces the face to be a plane+ faceBuilder <- MakeFace.fromWire wire True+ MakeFace.face faceBuilder++solidFromFaces :: [Ptr TopoDS.Face] -> Acquire (Ptr TopoDS.Solid)+solidFromFaces faces = do+ sewing <- BRepBuilderAPI.Sewing.new 1e-6 True True True False+ compound <- TopoDS.Compound.new+ builder <- TopoDS.Builder.new+ liftIO $ TopoDS.Builder.makeCompound builder compound+ _ <- liftIO $ traverse (TopoDS.Builder.add builder (Inheritance.upcast compound) . Inheritance.upcast) faces+ liftIO $ BRepBuilderAPI.Sewing.load sewing (Inheritance.upcast compound)+ liftIO . BRepBuilderAPI.Sewing.perform $ sewing+ shape <- BRepBuilderAPI.Sewing.sewedShape sewing+ maybeShapeAsSolid <- makeSolidFromShell shape+ case maybeShapeAsSolid of + Just s -> return s+ Nothing -> error "Failed to construct solid from faces"++solidFromVerts :: [[V3 Double]] -> Solid+solidFromVerts = solidFromAcquire . fmap Inheritance.upcast . (solidFromFaces <=< traverse faceFromVerts)++-- | Regular Tetrahedron with unit side lengths+-- +-- One vertex is in the Z direction+tetrahedron :: Solid+tetrahedron = + let r = ((1/sqrt 8) *^)+ . rotate (unit _z) (pi/4)+ . rotate (V3 1 1 0) (pi - unangle (V2 1 (sqrt 2)))+ v1 = V3 1 1 1+ v2 = V3 1 (-1) (-1)+ v3 = V3 (-1) 1 (-1)+ v4 = V3 (-1) (-1) 1+ in solidFromVerts . fmap (fmap r) $+ [ [v1, v2, v3] + , [v1 ,v2, v4]+ , [v2, v3, v4]+ , [v3, v1, v4]+ ]++-- | Regular Octahedron with unit side lengths+--+-- The vertices of the Octahedra lie on the X, Y and Z axes+octahedron :: Solid+octahedron = + let h = 1 / sqrt 2+ t = unit _z ^* h+ b = negate t+ c1 = h *^ unit _x+ c2 = h *^ unit _y+ c3 = negate c1+ c4 = negate c2+ in solidFromVerts+ [ [t, c1, c2]+ , [t, c2, c3]+ , [t, c3, c4]+ , [t, c4, c1]+ , [b, c2, c1]+ , [b, c3, c2]+ , [b, c4, c3]+ , [b, c1, c4]+ ]++-- | Regular Icosahedron with unit side lengths+icosahedron :: Solid+icosahedron = + let phi = (1 + sqrt 5) / 2+ signs = [-1, 1]+ in solidFromVerts $+ [ + let a = zero & l1 .~ (V2 (s1 * phi/2) 0.5)+ b = zero & l1 .~ (V2 (s1 * phi/2) (-0.5))+ c = zero & l2 .~ (V2 (s2 * phi/2) (0.5 * s1))+ in if s1 < 0 then [b, a, c]+ else [a, b, c]+ | s1 <- signs+ , s2 <- signs+ , (l1, l2) <- [(_xy, _zx), (_zx, _yz), (_yz, _xy)]+ ] <> + [+ [ zero & _xy .~ (V2 (a * phi/2) (c * 0.5))+ , zero & _yz .~ (V2 (c * phi/2) (b * 0.5))+ , zero & _zx .~ (V2 (b * phi/2) (a * 0.5))+ ]+ | a <- signs+ , b <- signs+ , c <- signs+ ]++-- | Regular Dodecahedron with unit side lengths+dodecahedron :: Solid+dodecahedron = + let phi = (1 + sqrt 5)/2 + plusMinusOne = [1, -1]+ scale = phi / 2 + -- colours taken from https://commons.wikimedia.org/wiki/File:Dodecahedron_vertices.svg+ orange x y z = scale *^ V3 x y z+ green y z = scale *^ V3 0 (phi * y) (z / phi)+ blue x z = scale *^ V3 (x/phi) 0 (phi * z)+ pink x y = scale *^ V3 (phi * x) (y/phi) 0+ in solidFromVerts $+ [ \y z -> [ blue (-1) z, blue (1) z, orange (1) y z, green y z, orange (-1) y z]+ , \x y -> [ green y (-1), green y 1, orange x y 1, pink x y, orange x y (-1)] + , \x z -> [ pink x (-1), pink x 1, orange x 1 z, blue x z, orange x (-1) z] + ] <*> plusMinusOne <*> plusMinusOne gPropQuery :: (Ptr GProps.GProps -> Acquire a) -> Solid -> a gPropQuery f s = unsafeFromAcquire $ do
waterfall-cad.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: waterfall-cad-version: 0.6.0.1+version: 0.6.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@@ -71,7 +71,7 @@ , lattices >=2.0 && <3 , lens ==5.* , linear >=1.21 && <2- , opencascade-hs >=0.6.0.1 && <0.7+ , opencascade-hs >=0.6.1.0 && <0.7 , primitive >=0.7 && <0.10 , resourcet >=1.2 && <1.4 default-language: Haskell2010