From a13d8fb85f708a9271c6e0b7c6823c78dc1cc2b4 Mon Sep 17 00:00:00 2001 From: Ryan Trinkle Date: Sat, 6 Feb 2021 21:29:16 -0500 Subject: [PATCH 1/2] Rather than using a heuristic, choose whichever point is closest to the surface --- Graphics/Implicit/Export/Render/TesselateLoops.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Graphics/Implicit/Export/Render/TesselateLoops.hs b/Graphics/Implicit/Export/Render/TesselateLoops.hs index d558ea35..e7f1e1bb 100644 --- a/Graphics/Implicit/Export/Render/TesselateLoops.hs +++ b/Graphics/Implicit/Export/Render/TesselateLoops.hs @@ -87,8 +87,8 @@ tesselateLoop res obj pathSides = pure $ Tris $ TriangleMesh $ normal = preNormal ^/ preNormalNorm deriv = (obj (mid + (normal ^* (res/100)) ) - midval)/res*100 mid' = mid - normal ^* (midval/deriv) - in if abs midval > res/50 && preNormalNorm > 0.5 && abs deriv > 0.5 - && abs (midval/deriv) < 2*res && 3*abs (obj mid') < abs midval + midval' = obj mid' + in if abs midval' < abs midval then early_tris <> [Triangle (a,b,mid') | (a,b) <- zip path (tail path <> [head path]) ] else early_tris <> [Triangle (a,b,mid) | (a,b) <- zip path (tail path <> [head path]) ] From 420815d716b6e486ab7de748aca6d682b087e31f Mon Sep 17 00:00:00 2001 From: Ryan Trinkle Date: Sat, 6 Feb 2021 18:51:02 -0500 Subject: [PATCH 2/2] Add some basic provenance tracking for triangles --- Graphics/Implicit/Definitions.hs | 26 +++++++- Graphics/Implicit/Export/Render.hs | 11 +++- .../Implicit/Export/Render/Definitions.hs | 13 +++- .../Implicit/Export/Render/HandleSquares.hs | 66 +++++++++---------- .../Implicit/Export/Render/TesselateLoops.hs | 22 +++---- Graphics/Implicit/Export/SymbolicObj3.hs | 27 +++++--- 6 files changed, 105 insertions(+), 60 deletions(-) diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs index b8934e71..8945b092 100644 --- a/Graphics/Implicit/Definitions.hs +++ b/Graphics/Implicit/Definitions.hs @@ -27,6 +27,8 @@ module Graphics.Implicit.Definitions ( Triangle(Triangle), NormedTriangle(NormedTriangle), TriangleMesh(TriangleMesh), + AnnotatedTriangleMesh(AnnotatedTriangleMesh, unAnnotatedTriangleMesh), + TriangleProvenance(..), NormedTriangleMesh(NormedTriangleMesh), Obj2, Obj3, @@ -64,12 +66,13 @@ module Graphics.Implicit.Definitions ( toScaleFn, isScaleID, quaternionToEuler, + removeTriangleMeshAnnotations, ) where import GHC.Generics (Generic) -import Prelude (Ord, Eq, atan2, asin, pi, (>=), signum, abs, (+), (-), RealFloat, (==), ($), flip, Semigroup((<>)), Monoid (mempty), Double, Either(Left, Right), Bool(True, False), (*), (/), fromIntegral, Float, realToFrac) +import Prelude (Ord, Eq, atan2, asin, pi, (>=), signum, abs, (+), (-), RealFloat, (==), ($), flip, Semigroup((<>)), Monoid (mempty), Double, Either(Left, Right), Bool(True, False), (*), (/), fromIntegral, Float, realToFrac, map, fst, Int, seq) import Graphics.Implicit.FastIntUtil as F (Fastℕ(Fastℕ), fromFastℕ, toFastℕ) @@ -162,6 +165,18 @@ newtype NormedTriangle = NormedTriangle ((ℝ3, ℝ3), (ℝ3, ℝ3), (ℝ3, ℝ3 -- | A triangle mesh is a bunch of triangles, attempting to be a surface. newtype TriangleMesh = TriangleMesh [Triangle] +newtype AnnotatedTriangleMesh a = AnnotatedTriangleMesh { unAnnotatedTriangleMesh :: [(Triangle, a)] } + +removeTriangleMeshAnnotations :: AnnotatedTriangleMesh a -> TriangleMesh +removeTriangleMeshAnnotations (AnnotatedTriangleMesh l) = TriangleMesh $ map fst l + +data TriangleProvenance + = TriangleProvenance_SquareToTri Bool TriangleProvenance + | TriangleProvenance_JoinXAligned TriangleProvenance TriangleProvenance + | TriangleProvenance_JoinYAligned TriangleProvenance TriangleProvenance + | TriangleProvenance_TesselateLoop Int + deriving (Show, Eq, Ord) + -- | A normed triangle mesh is a mesh of normed triangles. newtype NormedTriangleMesh = NormedTriangleMesh [NormedTriangle] @@ -174,6 +189,15 @@ instance NFData Triangle where instance NFData TriangleMesh where rnf (TriangleMesh xs) = rnf xs +instance NFData a => NFData (AnnotatedTriangleMesh a) where + rnf (AnnotatedTriangleMesh xs) = rnf xs + +instance NFData TriangleProvenance where + rnf (TriangleProvenance_SquareToTri b p) = rnf b `seq` rnf p + rnf (TriangleProvenance_JoinXAligned a b) = rnf a `seq` rnf b + rnf (TriangleProvenance_JoinYAligned a b) = rnf a `seq` rnf b + rnf (TriangleProvenance_TesselateLoop n) = rnf n + instance NFData Polytri where rnf (Polytri (a,b,c)) = rnf (a,b,c) diff --git a/Graphics/Implicit/Export/Render.hs b/Graphics/Implicit/Export/Render.hs index 616e9229..ed578860 100644 --- a/Graphics/Implicit/Export/Render.hs +++ b/Graphics/Implicit/Export/Render.hs @@ -6,11 +6,11 @@ {-# LANGUAGE ParallelListComp #-} -- export getContour and getMesh, which returns the edge of a 2D object, or the surface of a 3D object, respectively. -module Graphics.Implicit.Export.Render (getMesh, getContour) where +module Graphics.Implicit.Export.Render (getMesh, getAnnotatedMesh, getContour) where import Prelude(error, (-), ceiling, ($), (+), (*), max, div, tail, fmap, reverse, (.), foldMap, min, Int, (<>), (<$>)) -import Graphics.Implicit.Definitions (ℝ, ℕ, Fastℕ, ℝ2, ℝ3, TriangleMesh, Obj2, SymbolicObj2, Obj3, SymbolicObj3, Polyline(Polyline), (⋯/), fromℕtoℝ, fromℕ) +import Graphics.Implicit.Definitions (ℝ, ℕ, Fastℕ, ℝ2, ℝ3, TriangleMesh, Obj2, SymbolicObj2, Obj3, SymbolicObj3, Polyline(Polyline), (⋯/), fromℕtoℝ, fromℕ, AnnotatedTriangleMesh, removeTriangleMeshAnnotations, TriangleProvenance(..)) import Graphics.Implicit.Export.Symbolic.Rebound2 (rebound2) @@ -21,6 +21,8 @@ import Graphics.Implicit.ObjectUtil (getBox2, getBox3) import Data.Foldable(fold) import Linear ( V3(V3), V2(V2) ) +import GHC.Stack + -- Here's the plan for rendering a cube (the 2D case is trivial): -- (1) We calculate midpoints using interpolate. @@ -75,7 +77,10 @@ import Graphics.Implicit.Primitives (getImplicit) default (ℕ, Fastℕ, ℝ) getMesh :: ℝ3 -> SymbolicObj3 -> TriangleMesh -getMesh res@(V3 xres yres zres) symObj = +getMesh res symObj = removeTriangleMeshAnnotations $ getAnnotatedMesh res symObj + +getAnnotatedMesh :: ℝ3 -> SymbolicObj3 -> AnnotatedTriangleMesh TriangleProvenance +getAnnotatedMesh res@(V3 xres yres zres) symObj = let -- Grow bounds a little to avoid sampling at exact bounds (obj, (p1@(V3 x1 y1 z1), p2)) = rebound3 (getImplicit symObj, getBox3 symObj) diff --git a/Graphics/Implicit/Export/Render/Definitions.hs b/Graphics/Implicit/Export/Render/Definitions.hs index 3013fed8..1bc06288 100644 --- a/Graphics/Implicit/Export/Render/Definitions.hs +++ b/Graphics/Implicit/Export/Render/Definitions.hs @@ -2,10 +2,12 @@ -- Released under the GNU AGPLV3+, see LICENSE -- We want a type that can represent squares/quads and triangles. -module Graphics.Implicit.Export.Render.Definitions (TriSquare(Tris, Sq)) where +module Graphics.Implicit.Export.Render.Definitions (TriSquare(Tris, Sq), AnnotatedTriSquare(AnnotatedSq, AnnotatedTris)) where + +import Prelude (seq) -- Points/Numbers, and the concept of an array of triangles. -import Graphics.Implicit.Definitions(ℝ, ℝ2, ℝ3, TriangleMesh) +import Graphics.Implicit.Definitions(ℝ, ℝ2, ℝ3, TriangleMesh, AnnotatedTriangleMesh) -- So we can use Parallel on this type. import Control.DeepSeq (NFData, rnf) @@ -14,7 +16,14 @@ data TriSquare = Sq (ℝ3,ℝ3,ℝ3) ℝ ℝ2 ℝ2 | Tris TriangleMesh +data AnnotatedTriSquare a = + AnnotatedSq (ℝ3,ℝ3,ℝ3) ℝ ℝ2 ℝ2 a + | AnnotatedTris (AnnotatedTriangleMesh a) + instance NFData TriSquare where rnf (Sq b z xS yS) = rnf (b,z,xS,yS) rnf (Tris tris) = rnf tris +instance NFData a => NFData (AnnotatedTriSquare a) where + rnf (AnnotatedSq b z xS yS a) = rnf (b,z,xS,yS) `seq` rnf a + rnf (AnnotatedTris tris) = rnf tris diff --git a/Graphics/Implicit/Export/Render/HandleSquares.hs b/Graphics/Implicit/Export/Render/HandleSquares.hs index e0f034c9..007649bc 100644 --- a/Graphics/Implicit/Export/Render/HandleSquares.hs +++ b/Graphics/Implicit/Export/Render/HandleSquares.hs @@ -4,11 +4,11 @@ module Graphics.Implicit.Export.Render.HandleSquares (mergedSquareTris) where -import Prelude((+), foldMap, (<>), ($), fmap, concat, (.), (==), compare, error, otherwise, concatMap) +import Prelude((+), foldMap, (<>), ($), fmap, concat, (.), (==), compare, error, otherwise, concatMap, Bool(..)) -import Graphics.Implicit.Definitions (TriangleMesh(TriangleMesh), Triangle(Triangle)) +import Graphics.Implicit.Definitions (TriangleMesh(TriangleMesh), Triangle(Triangle), AnnotatedTriangleMesh (AnnotatedTriangleMesh, unAnnotatedTriangleMesh), TriangleProvenance(..)) -import Graphics.Implicit.Export.Render.Definitions (TriSquare(Tris, Sq)) +import Graphics.Implicit.Export.Render.Definitions (TriSquare(Tris, Sq), AnnotatedTriSquare(AnnotatedTris, AnnotatedSq)) import Linear ( V2(V2), (*^), (^*) ) import GHC.Exts (groupWith) @@ -57,75 +57,75 @@ import Data.List (sortBy) -} -mergedSquareTris :: [TriSquare] -> TriangleMesh +mergedSquareTris :: [AnnotatedTriSquare TriangleProvenance] -> AnnotatedTriangleMesh TriangleProvenance mergedSquareTris sqTris = let -- We don't need to do any work on triangles. They'll just be part of -- the list of triangles we give back. So, the triangles coming from -- triangles... - triTriangles :: [Triangle] - triTriangles = [tri | Tris tris <- sqTris, tri <- unmesh tris ] + triTriangles :: [(Triangle, TriangleProvenance)] + triTriangles = [tri | AnnotatedTris tris <- sqTris, tri <- unAnnotatedTriangleMesh tris ] -- We actually want to work on the quads, so we find those - squaresFromTris :: [TriSquare] - squaresFromTris = [ Sq x y z q | Sq x y z q <- sqTris ] + squaresFromTris :: [AnnotatedTriSquare TriangleProvenance] + squaresFromTris = [ AnnotatedSq x y z q a | AnnotatedSq x y z q a <- sqTris ] unmesh (TriangleMesh m) = m -- Collect squares that are on the same plane. - planeAligned = groupWith (\(Sq basis z _ _) -> (basis,z)) squaresFromTris + planeAligned = groupWith (\(AnnotatedSq basis z _ _ a) -> (basis,z,a)) squaresFromTris -- For each plane: -- Select for being the same range on X and then merge them on Y -- Then vice versa. - joined :: [[TriSquare]] + joined :: [[AnnotatedTriSquare TriangleProvenance]] joined = fmap - ( concatMap joinXaligned . groupWith (\(Sq _ _ xS _) -> xS) - . concatMap joinYaligned . groupWith (\(Sq _ _ _ yS) -> yS) - . concatMap joinXaligned . groupWith (\(Sq _ _ xS _) -> xS)) + ( concatMap joinXaligned . groupWith (\(AnnotatedSq _ _ xS _ _) -> xS) + . concatMap joinYaligned . groupWith (\(AnnotatedSq _ _ _ yS _) -> yS) + . concatMap joinXaligned . groupWith (\(AnnotatedSq _ _ xS _ _) -> xS)) planeAligned -- Merge them back together, and we have the desired reult! finishedSquares = concat joined in -- merge them to triangles, and combine with the original triangles. - TriangleMesh $ triTriangles <> foldMap squareToTri finishedSquares + AnnotatedTriangleMesh $ triTriangles <> foldMap squareToTri finishedSquares -- And now for the helper functions that do the heavy lifting... -joinXaligned :: [TriSquare] -> [TriSquare] -joinXaligned quads@((Sq b z xS _):_) = +joinXaligned :: [AnnotatedTriSquare TriangleProvenance] -> [AnnotatedTriSquare TriangleProvenance] +joinXaligned quads@((AnnotatedSq b z xS _ _):_) = let orderedQuads = sortBy - (\(Sq _ _ _ (V2 ya _)) (Sq _ _ _ (V2 yb _)) -> compare ya yb) + (\(AnnotatedSq _ _ _ (V2 ya _) _) (AnnotatedSq _ _ _ (V2 yb _) _) -> compare ya yb) quads - mergeAdjacent (pres@(Sq _ _ _ (V2 y1a y2a)) : next@(Sq _ _ _ (V2 y1b y2b)) : others) - | y2a == y1b = mergeAdjacent (Sq b z xS (V2 y1a y2b) : others) - | y1a == y2b = mergeAdjacent (Sq b z xS (V2 y1b y2a) : others) + mergeAdjacent (pres@(AnnotatedSq _ _ _ (V2 y1a y2a) a1) : next@(AnnotatedSq _ _ _ (V2 y1b y2b) a2) : others) + | y2a == y1b = mergeAdjacent (AnnotatedSq b z xS (V2 y1a y2b) (TriangleProvenance_JoinXAligned a1 a2) : others) + | y1a == y2b = mergeAdjacent (AnnotatedSq b z xS (V2 y1b y2a) (TriangleProvenance_JoinXAligned a1 a2) : others) | otherwise = pres : mergeAdjacent (next : others) mergeAdjacent a = a in mergeAdjacent orderedQuads -joinXaligned (Tris _:_) = error "Tried to join y aligned triangles." +joinXaligned (AnnotatedTris _:_) = error "Tried to join y aligned triangles." joinXaligned [] = [] -joinYaligned :: [TriSquare] -> [TriSquare] -joinYaligned quads@((Sq b z _ yS):_) = +joinYaligned :: [AnnotatedTriSquare TriangleProvenance] -> [AnnotatedTriSquare TriangleProvenance] +joinYaligned quads@((AnnotatedSq b z _ yS _):_) = let orderedQuads = sortBy - (\(Sq _ _ (V2 xa _) _) (Sq _ _ (V2 xb _) _) -> compare xa xb) + (\(AnnotatedSq _ _ (V2 xa _) _ _) (AnnotatedSq _ _ (V2 xb _) _ _) -> compare xa xb) quads - mergeAdjacent (pres@(Sq _ _ (V2 x1a x2a) _) : next@(Sq _ _ (V2 x1b x2b) _) : others) - | x2a == x1b = mergeAdjacent (Sq b z (V2 x1a x2b) yS : others) - | x1a == x2b = mergeAdjacent (Sq b z (V2 x1b x2a) yS : others) + mergeAdjacent (pres@(AnnotatedSq _ _ (V2 x1a x2a) _ a1) : next@(AnnotatedSq _ _ (V2 x1b x2b) _ a2) : others) + | x2a == x1b = mergeAdjacent (AnnotatedSq b z (V2 x1a x2b) yS (TriangleProvenance_JoinYAligned a1 a2) : others) + | x1a == x2b = mergeAdjacent (AnnotatedSq b z (V2 x1b x2a) yS (TriangleProvenance_JoinYAligned a1 a2) : others) | otherwise = pres : mergeAdjacent (next : others) mergeAdjacent a = a in mergeAdjacent orderedQuads -joinYaligned (Tris _:_) = error "Tried to join y aligned triangles." +joinYaligned (AnnotatedTris _:_) = error "Tried to join y aligned triangles." joinYaligned [] = [] -- Deconstruct a square into two triangles. -squareToTri :: TriSquare -> [Triangle] -squareToTri (Sq (b1,b2,b3) z (V2 x1 x2) (V2 y1 y2)) = +squareToTri :: AnnotatedTriSquare TriangleProvenance -> [(Triangle, TriangleProvenance)] +squareToTri (AnnotatedSq (b1,b2,b3) z (V2 x1 x2) (V2 y1 y2) ann) = let zV = b3 ^* z (x1V, x2V) = (x1 *^ b1, x2 *^ b1) @@ -135,8 +135,8 @@ squareToTri (Sq (b1,b2,b3) z (V2 x1 x2) (V2 y1 y2)) = c = zV + x1V + y2V d = zV + x2V + y2V in - [Triangle (a,b,c), Triangle (c,b,d)] -squareToTri (Tris t) = unmesh t + [(Triangle (a,b,c), TriangleProvenance_SquareToTri False ann), (Triangle (c,b,d), TriangleProvenance_SquareToTri True ann)] +squareToTri (AnnotatedTris t) = unmesh t where - unmesh (TriangleMesh a) = a + unmesh (AnnotatedTriangleMesh a) = a diff --git a/Graphics/Implicit/Export/Render/TesselateLoops.hs b/Graphics/Implicit/Export/Render/TesselateLoops.hs index e7f1e1bb..d72c5cd6 100644 --- a/Graphics/Implicit/Export/Render/TesselateLoops.hs +++ b/Graphics/Implicit/Export/Render/TesselateLoops.hs @@ -6,9 +6,9 @@ module Graphics.Implicit.Export.Render.TesselateLoops (tesselateLoop) where import Prelude(sum, (-), pure, ($), length, (==), zip, init, tail, reverse, (<), (/), null, (<>), head, (*), abs, (>), (&&), (+), foldMap) -import Graphics.Implicit.Definitions (ℝ, ℕ, Obj3, ℝ3, TriangleMesh(TriangleMesh), Triangle(Triangle)) +import Graphics.Implicit.Definitions (ℝ, ℕ, Obj3, ℝ3, TriangleMesh(TriangleMesh), Triangle(Triangle), AnnotatedTriangleMesh(AnnotatedTriangleMesh), TriangleProvenance(..)) -import Graphics.Implicit.Export.Render.Definitions (TriSquare(Tris)) +import Graphics.Implicit.Export.Render.Definitions (TriSquare(Tris), AnnotatedTriSquare(AnnotatedTris)) import Graphics.Implicit.Export.Util (centroid) @@ -17,11 +17,11 @@ import Linear ( cross, Metric(norm), (^*), (^/) ) -- de-compose a loop into a series of triangles or squares. -- FIXME: res should be ℝ3. -tesselateLoop :: ℝ -> Obj3 -> [[ℝ3]] -> [TriSquare] +tesselateLoop :: ℝ -> Obj3 -> [[ℝ3]] -> [AnnotatedTriSquare TriangleProvenance] tesselateLoop _ _ [] = [] -tesselateLoop _ _ [[a,b],[_,c],[_,_]] = [Tris $ TriangleMesh [Triangle (a,b,c)]] +tesselateLoop _ _ [[a,b],[_,c],[_,_]] = [AnnotatedTris $ AnnotatedTriangleMesh [(Triangle (a,b,c), TriangleProvenance_TesselateLoop 0)]] {- @@ -67,12 +67,12 @@ tesselateLoop _ _ [[a,_],[b,_],[c,_],[d,_]] | centroid [a,c] == centroid [b,d] = -- | Create a pair of triangles from a quad. -- FIXME: magic number tesselateLoop res obj [[a,_],[b,_],[c,_],[d,_]] | obj (centroid [a,c]) < res/30 = - pure $ Tris $ TriangleMesh [Triangle (a,b,c), Triangle (a,c,d)] + pure $ AnnotatedTris $ AnnotatedTriangleMesh [(Triangle (a,b,c), TriangleProvenance_TesselateLoop 1), (Triangle (a,c,d), TriangleProvenance_TesselateLoop 2)] -- Fallback case: make fans -- FIXME: magic numbers. -tesselateLoop res obj pathSides = pure $ Tris $ TriangleMesh $ +tesselateLoop res obj pathSides = pure $ AnnotatedTris $ AnnotatedTriangleMesh $ let path' = foldMap init pathSides (early_tris,path) = shrinkLoop 0 path' res obj @@ -89,16 +89,16 @@ tesselateLoop res obj pathSides = pure $ Tris $ TriangleMesh $ mid' = mid - normal ^* (midval/deriv) midval' = obj mid' in if abs midval' < abs midval - then early_tris <> [Triangle (a,b,mid') | (a,b) <- zip path (tail path <> [head path]) ] - else early_tris <> [Triangle (a,b,mid) | (a,b) <- zip path (tail path <> [head path]) ] + then early_tris <> [(Triangle (a,b,mid'), TriangleProvenance_TesselateLoop 3) | (a,b) <- zip path (tail path <> [head path]) ] + else early_tris <> [(Triangle (a,b,mid), TriangleProvenance_TesselateLoop 4) | (a,b) <- zip path (tail path <> [head path]) ] -shrinkLoop :: ℕ -> [ℝ3] -> ℝ -> Obj3 -> ([Triangle], [ℝ3]) +shrinkLoop :: ℕ -> [ℝ3] -> ℝ -> Obj3 -> ([(Triangle, TriangleProvenance)], [ℝ3]) shrinkLoop _ path@[a,b,c] res obj = if abs (obj $ centroid [a,b,c]) < res/50 then - ( [Triangle (a,b,c)], []) + ( [(Triangle (a,b,c), TriangleProvenance_TesselateLoop 5)], []) else ([], path) @@ -107,7 +107,7 @@ shrinkLoop n path@(a:b:c:xs) res obj | n < genericLength path = if abs (obj (centroid [a,c])) < res/50 then let (tris,remainder) = shrinkLoop 0 (a:c:xs) res obj - in (Triangle (a,b,c):tris, remainder) + in ((Triangle (a,b,c), TriangleProvenance_TesselateLoop 6):tris, remainder) else shrinkLoop (n+1) (b:c:xs <> [a]) res obj diff --git a/Graphics/Implicit/Export/SymbolicObj3.hs b/Graphics/Implicit/Export/SymbolicObj3.hs index fd4073f9..07c6eb13 100644 --- a/Graphics/Implicit/Export/SymbolicObj3.hs +++ b/Graphics/Implicit/Export/SymbolicObj3.hs @@ -5,19 +5,26 @@ -- The purpose of this function is to symbolicaly compute triangle meshes using the symbolic system where possible. -- Otherwise we coerce it into an implicit function and apply our modified marching cubes algorithm. -module Graphics.Implicit.Export.SymbolicObj3 (symbolicGetMesh) where +module Graphics.Implicit.Export.SymbolicObj3 (symbolicGetMesh, symbolicGetAnnotatedMesh) where -import Prelude(pure, zip, length, filter, (>), ($), null, (<>), foldMap, (.), (<$>)) +import Prelude(pure, zip, length, filter, (>), ($), null, (<>), foldMap, (.), (<$>), unlines, zipWith, show, map, snd) -import Graphics.Implicit.Definitions (ℝ, ℝ3, SymbolicObj3(Shared3), SharedObj(UnionR), Triangle, TriangleMesh(TriangleMesh)) -import Graphics.Implicit.Export.Render (getMesh) +import Graphics.Implicit.Definitions (ℝ, ℝ3, SymbolicObj3(Shared3), SharedObj(UnionR), Triangle, TriangleMesh(TriangleMesh), AnnotatedTriangleMesh(AnnotatedTriangleMesh,unAnnotatedTriangleMesh), removeTriangleMeshAnnotations, TriangleProvenance) +import Graphics.Implicit.Export.Render (getAnnotatedMesh) import Graphics.Implicit.ObjectUtil (getBox3) import Graphics.Implicit.MathUtil(box3sWithin) import Control.Arrow(first, second) +import Debug.Trace + symbolicGetMesh :: ℝ -> SymbolicObj3 -> TriangleMesh -symbolicGetMesh res inputObj@(Shared3 (UnionR r objs)) = TriangleMesh $ +symbolicGetMesh res inputObj = removeTriangleMeshAnnotations $ trace annotations mesh + where mesh = symbolicGetAnnotatedMesh res inputObj + annotations = unlines $ zipWith (\n a -> show n <> "\t" <> show a) [1..] $ map snd $ unAnnotatedTriangleMesh mesh + +symbolicGetAnnotatedMesh :: ℝ -> SymbolicObj3 -> AnnotatedTriangleMesh TriangleProvenance +symbolicGetAnnotatedMesh res inputObj@(Shared3 (UnionR r objs)) = AnnotatedTriangleMesh $ let boxes = getBox3 <$> objs boxedObjs = zip boxes objs @@ -31,14 +38,14 @@ symbolicGetMesh res inputObj@(Shared3 (UnionR r objs)) = TriangleMesh $ (dependants, independents) = sepFree boxedObjs in if null independents - then unmesh $ getMesh (pure res) inputObj + then unAnnotatedTriangleMesh $ getAnnotatedMesh (pure res) inputObj else if null dependants - then foldMap (unmesh . symbolicGetMesh res) independents - else foldMap (unmesh . symbolicGetMesh res) independents - <> unmesh (symbolicGetMesh res (Shared3 (UnionR r dependants))) + then foldMap (unAnnotatedTriangleMesh . symbolicGetAnnotatedMesh res) independents + else foldMap (unAnnotatedTriangleMesh . symbolicGetAnnotatedMesh res) independents + <> unAnnotatedTriangleMesh (symbolicGetAnnotatedMesh res (Shared3 (UnionR r dependants))) -- | If all that fails, coerce and apply marching cubes :( -symbolicGetMesh res obj = getMesh (pure res) obj +symbolicGetAnnotatedMesh res obj = getAnnotatedMesh (pure res) obj unmesh :: TriangleMesh -> [Triangle] unmesh (TriangleMesh m) = m