Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add some basic provenance tracking for triangles #374

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 25 additions & 1 deletion Graphics/Implicit/Definitions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@ module Graphics.Implicit.Definitions (
Triangle(Triangle),
NormedTriangle(NormedTriangle),
TriangleMesh(TriangleMesh),
AnnotatedTriangleMesh(AnnotatedTriangleMesh, unAnnotatedTriangleMesh),
TriangleProvenance(..),
NormedTriangleMesh(NormedTriangleMesh),
Obj2,
Obj3,
Expand Down Expand Up @@ -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ℕ)

Expand Down Expand Up @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What is this bool?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There are just two call sites :P I'll put an enum type in before we consider merging.

| TriangleProvenance_JoinXAligned TriangleProvenance TriangleProvenance
| TriangleProvenance_JoinYAligned TriangleProvenance TriangleProvenance
| TriangleProvenance_TesselateLoop Int
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

And this int?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yep, just an enum I haven't bothered writing yet.

deriving (Show, Eq, Ord)

-- | A normed triangle mesh is a mesh of normed triangles.
newtype NormedTriangleMesh = NormedTriangleMesh [NormedTriangle]

Expand All @@ -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)

Expand Down
11 changes: 8 additions & 3 deletions Graphics/Implicit/Export/Render.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -21,6 +21,8 @@ import Graphics.Implicit.ObjectUtil (getBox2, getBox3)
import Data.Foldable(fold)
import Linear ( V3(V3), V2(V2) )

import GHC.Stack
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

what's this imported for?


-- Here's the plan for rendering a cube (the 2D case is trivial):

-- (1) We calculate midpoints using interpolate.
Expand Down Expand Up @@ -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)
Expand Down
13 changes: 11 additions & 2 deletions Graphics/Implicit/Export/Render/Definitions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
66 changes: 33 additions & 33 deletions Graphics/Implicit/Export/Render/HandleSquares.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand All @@ -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

26 changes: 13 additions & 13 deletions Graphics/Implicit/Export/Render/TesselateLoops.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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)]]


{-
Expand Down Expand Up @@ -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
Expand All @@ -87,18 +87,18 @@ 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
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]) ]
midval' = obj mid'
in if abs midval' < abs midval
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)

Expand All @@ -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

Expand Down
27 changes: 17 additions & 10 deletions Graphics/Implicit/Export/SymbolicObj3.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also this one.


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
Expand All @@ -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