diff --git a/Graphics/Implicit/ExtOpenScad/Definitions.hs b/Graphics/Implicit/ExtOpenScad/Definitions.hs index 8aada36f..413c2cca 100644 --- a/Graphics/Implicit/ExtOpenScad/Definitions.hs +++ b/Graphics/Implicit/ExtOpenScad/Definitions.hs @@ -21,7 +21,7 @@ module Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch StatementI(StatementI), Statement(DoNothing, NewModule, Include, If, ModuleCall, (:=)), OVal(OIO, ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, ONModuleWithSuite, OVargsModule, OError, OObj2, OObj3), - TestInvariant(EulerCharacteristic, ContoursAreClosed), + TestInvariant(EulerCharacteristic, ContoursAreClosed, MeshIsWaterTight), SourcePosition(SourcePosition), StateC, CompState(CompState, scadVars, oVals, sourceDir), @@ -306,4 +306,5 @@ lookupVarIn target (VarLookup vars) = lookup (Symbol target) vars data TestInvariant = EulerCharacteristic ℕ | ContoursAreClosed + | MeshIsWaterTight deriving (Show) diff --git a/Graphics/Implicit/ExtOpenScad/Primitives.hs b/Graphics/Implicit/ExtOpenScad/Primitives.hs index 0f0ed941..bb1274ba 100644 --- a/Graphics/Implicit/ExtOpenScad/Primitives.hs +++ b/Graphics/Implicit/ExtOpenScad/Primitives.hs @@ -23,7 +23,7 @@ import Graphics.Implicit.Export.Util (centroid) import Graphics.Implicit.ExtOpenScad.Definitions (OVal (OObj2, OObj3, ONModule, ONModuleWithSuite), ArgParser, Symbol(Symbol), StateC, SourcePosition) -import Graphics.Implicit.ExtOpenScad.Util.ArgParser (contoursAreClosed, doc, defaultTo, example, test, eulerCharacteristic) +import Graphics.Implicit.ExtOpenScad.Util.ArgParser (contoursAreClosed, doc, defaultTo, example, meshIsWaterTight, test, eulerCharacteristic) import qualified Graphics.Implicit.ExtOpenScad.Util.ArgParser as GIEUA (argument) @@ -150,11 +150,11 @@ cube = moduleWithoutSuite "cube" $ \_ -> do example "cube(size = [2,3,4], center = true, r = 0.5);" example "cube(4);" -- Tests - test "cube(4);" + meshIsWaterTight $ test "cube(4);" `eulerCharacteristic` 2 - test "cube(size=[2,3,4]);" + meshIsWaterTight $ test "cube(size=[2,3,4]);" `eulerCharacteristic` 2 - test "cube([2,3,4]);" -- openscad syntax + meshIsWaterTight $ test "cube([2,3,4]);" -- openscad syntax `eulerCharacteristic` 2 -- arguments (two forms) (V2 x1 x2, V2 y1 y2, V2 z1 z2) <- @@ -296,6 +296,7 @@ cylinder = moduleWithoutSuite "cylinder" $ \_ -> do polyhedron :: (Symbol, SourcePosition -> ArgParser (StateC [OVal])) polyhedron = moduleWithoutSuite "polyhedron" $ \sourcePos -> do example "polyhedron(points=[[0,0,0], [2,0,0], [2,2,0], [0,2,0], [1, 1, 2]], faces=[[0,1,2,3], [0,4,1], [1,4,2], [2,4,3], [3,4,0]]);" + meshIsWaterTight $ test "polyhedron(points=[[0,0,0], [2,0,0], [2,2,0], [0,2,0], [1, 1, 2]], faces=[[0,1,2,3], [0,4,1], [1,4,2], [2,4,3], [3,4,0]]);" `eulerCharacteristic` 2 -- Arguments -- FIXME: find a way to mark an arguement as non-empty! points :: [ℝ3] <- argument "points" `doc` "list of points to construct faces from" @@ -420,7 +421,7 @@ torus :: (Symbol, SourcePosition -> ArgParser (StateC [OVal])) torus = moduleWithoutSuite "torus" $ \_ -> do example "torus(r1=10, r2=5);" -- Tests - test "torus(r1=10, r2=5);" + meshIsWaterTight $ test "torus(r1=10, r2=5);" `eulerCharacteristic` 0 -- arguments (r1, r2) <- (,) diff --git a/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs b/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs index 767d6002..0882301a 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs @@ -18,6 +18,7 @@ module Graphics.Implicit.ExtOpenScad.Util.ArgParser ( defaultTo, eulerCharacteristic, example, + meshIsWaterTight, test ) where @@ -25,7 +26,7 @@ module Graphics.Implicit.ExtOpenScad.Util.ArgParser ( import Prelude(String, Maybe(Just, Nothing), ($), (<>), concatMap, error, otherwise, show, return, fmap, snd, filter, (.), fst, foldl1, not, (&&), (<$>), maybe) import qualified Prelude as P (null) -import Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch, APTerminator, APFail, APExample), OVal (OError), TestInvariant(EulerCharacteristic, ContoursAreClosed), Symbol, VarLookup(VarLookup)) +import Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch, APTerminator, APFail, APExample), OVal (OError), TestInvariant(EulerCharacteristic, ContoursAreClosed, MeshIsWaterTight), Symbol, VarLookup(VarLookup)) import Graphics.Implicit.ExtOpenScad.Util.OVal (fromOObj, toOObj, OTypeMirror) @@ -100,6 +101,10 @@ contoursAreClosed :: ArgParser a -> ArgParser a contoursAreClosed (APTest str maybeRes tests child) = APTest str maybeRes (ContoursAreClosed:tests) child contoursAreClosed _ = APFail "contoursAreClosed called on an Argparser that isn't APTest" +meshIsWaterTight :: ArgParser a -> ArgParser a +meshIsWaterTight (APTest str maybeRes tests child) = APTest str maybeRes (MeshIsWaterTight:tests) child +meshIsWaterTight _ = APFail "meshIsWaterTight called on an Argparser that isn't APTest" + -- * Tools for handeling ArgParsers -- | Retrieve all of the tests diff --git a/implicit.cabal b/implicit.cabal index eba46fb0..9ff56c46 100644 --- a/implicit.cabal +++ b/implicit.cabal @@ -240,6 +240,7 @@ Test-suite test-implicit Build-depends: base, bytestring, + containers, hspec, HUnit, implicit, diff --git a/tests/ImplicitSpec.hs b/tests/ImplicitSpec.hs index ffdbc3e4..6350c017 100644 --- a/tests/ImplicitSpec.hs +++ b/tests/ImplicitSpec.hs @@ -46,7 +46,7 @@ import Graphics.Implicit.ExtOpenScad.Util.ArgParser (collectTests) import Graphics.Implicit.Definitions (Polyline(Polyline), TriangleMesh, Triangle(Triangle), getTriangles) -import Graphics.Implicit.ExtOpenScad.Definitions(ScadOpts(ScadOpts), SourcePosition(SourcePosition), OVal(ONModule), TestInvariant(ContoursAreClosed,EulerCharacteristic)) +import Graphics.Implicit.ExtOpenScad.Definitions(ScadOpts(ScadOpts), SourcePosition(SourcePosition), OVal(ONModule), TestInvariant(ContoursAreClosed, EulerCharacteristic, MeshIsWaterTight)) import Graphics.Implicit.ExtOpenScad.Primitives(primitiveModules) @@ -56,6 +56,8 @@ import Data.Foldable (for_, mapM_) import Data.List (nub) +import Data.Map (elems, fromListWith) + import Data.Maybe (fromMaybe, Maybe(Nothing)) import Data.Text.Lazy (Text, unpack) @@ -415,6 +417,7 @@ check3DInvariant maybeRes obj invariant = case invariant of (EulerCharacteristic expected) -> eulerCharacteristicOf (getTriangles (discreteAprox res obj :: TriangleMesh)) `shouldBe` fromIntegral expected ContoursAreClosed -> error "cannot check for contours being closed in a 3D object!" + MeshIsWaterTight -> meshIsWaterTight (getTriangles (discreteAprox res obj :: TriangleMesh)) `shouldBe` True where res = fromMaybe 1 maybeRes @@ -423,6 +426,7 @@ check2DInvariant maybeRes obj invariant = case invariant of (EulerCharacteristic _) -> error "cannot perform euler characteristic finding on 2D objects." ContoursAreClosed -> allContoursAreClosed (discreteAprox res obj :: [Polyline]) `shouldBe` True + MeshIsWaterTight -> error "cannot perform mesh tests on 2D objects." where res = fromMaybe 1 maybeRes @@ -444,3 +448,11 @@ allContoursAreClosed :: [Polyline] -> Bool allContoursAreClosed polylines = all isClosed polylines where isClosed (Polyline points) = not (null points) && head points == last points + +meshIsWaterTight :: [Triangle] -> Bool +meshIsWaterTight triangles = all (==(2::Int)) $ elems edgeCounts + where + edgeCounts = fromListWith (+) [(edge, 1) | triangle <- triangles, edge <- edges triangle] + edges :: Triangle -> [(ℝ3,ℝ3)] + edges (Triangle (v1,v2,v3)) = [sortEdge v1 v2, sortEdge v2 v3, sortEdge v3 v1] + sortEdge v1 v2 = if v1 < v2 then (v1,v2) else (v2,v1)