add water tight test for meshes.

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)

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) <- (,)

Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs

@@ -18,14 +18,15 @@ module Graphics.Implicit.ExtOpenScad.Util.ArgParser (
   defaultTo,
   eulerCharacteristic,
   example,
+  meshIsWaterTight,
   test
   ) where
 
 -- imported twice, once qualified. null from Data.Map conflicts with null from Prelude.
 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

implicit.cabal

@@ -240,6 +240,7 @@ Test-suite test-implicit
     Build-depends:
                   base,
                   bytestring,
+                  containers,
                   hspec,
                   HUnit,
                   implicit,

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)