{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

-- 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

import Prelude(pure, zip, length, filter, (>), ($), null, (<>), foldMap, (.), (<$>))

import Graphics.Implicit.Definitions (ℝ, ℝ3, SymbolicObj3(Shared3), SharedObj(UnionR), TriangleMesh(TriangleMesh, getTriangles))
import Graphics.Implicit.Export.Render (getMesh)
import Graphics.Implicit.ObjectUtil (getBox3)
import Graphics.Implicit.MathUtil(box3sWithin)

import Control.Arrow(first, second)

symbolicGetMesh :: ℝ -> SymbolicObj3 -> TriangleMesh
symbolicGetMesh :: ℝ -> SymbolicObj3 -> TriangleMesh
symbolicGetMesh ℝ
res inputObj :: SymbolicObj3
inputObj@(Shared3 (UnionR ℝ
r [SymbolicObj3]
objs)) = [Triangle] -> TriangleMesh
TriangleMesh forall a b. (a -> b) -> a -> b
$
    let
        boxes :: [Box3]
boxes = SymbolicObj3 -> Box3
getBox3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SymbolicObj3]
objs
        boxedObjs :: [(Box3, SymbolicObj3)]
boxedObjs = forall a b. [a] -> [b] -> [(a, b)]
zip [Box3]
boxes [SymbolicObj3]
objs

        sepFree :: [((ℝ3, ℝ3), a)] -> ([a], [a])
        sepFree :: forall a. [(Box3, a)] -> ([a], [a])
sepFree ((Box3
box,a
obj):[(Box3, a)]
others) =
            if forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (ℝ -> Box3 -> Box3 -> Bool
box3sWithin ℝ
r Box3
box) [Box3]
boxes) forall a. Ord a => a -> a -> Bool
> Int
1
            then forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first  (a
obj forall a. a -> [a] -> [a]
: ) forall a b. (a -> b) -> a -> b
$ forall a. [(Box3, a)] -> ([a], [a])
sepFree [(Box3, a)]
others
            else forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
obj forall a. a -> [a] -> [a]
: ) forall a b. (a -> b) -> a -> b
$ forall a. [(Box3, a)] -> ([a], [a])
sepFree [(Box3, a)]
others
        sepFree [] = ([],[])

        ([SymbolicObj3]
dependants, [SymbolicObj3]
independents) = forall a. [(Box3, a)] -> ([a], [a])
sepFree [(Box3, SymbolicObj3)]
boxedObjs
    in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SymbolicObj3]
independents
          then TriangleMesh -> [Triangle]
getTriangles forall a b. (a -> b) -> a -> b
$ ℝ3 -> SymbolicObj3 -> TriangleMesh
getMesh (forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
res) SymbolicObj3
inputObj
          else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SymbolicObj3]
dependants
                  then forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TriangleMesh -> [Triangle]
getTriangles forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> SymbolicObj3 -> TriangleMesh
symbolicGetMesh ℝ
res) [SymbolicObj3]
independents
                  else forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TriangleMesh -> [Triangle]
getTriangles forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> SymbolicObj3 -> TriangleMesh
symbolicGetMesh ℝ
res) [SymbolicObj3]
independents
                       forall a. Semigroup a => a -> a -> a
<> TriangleMesh -> [Triangle]
getTriangles (ℝ -> SymbolicObj3 -> TriangleMesh
symbolicGetMesh ℝ
res (SharedObj SymbolicObj3 V3 ℝ -> SymbolicObj3
Shared3 (forall obj (f :: * -> *) a. ℝ -> [obj] -> SharedObj obj f a
UnionR ℝ
r [SymbolicObj3]
dependants)))

-- If all that fails, coerce and apply marching cubes :(
symbolicGetMesh ℝ
res SymbolicObj3
obj = ℝ3 -> SymbolicObj3 -> TriangleMesh
getMesh (forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
res) SymbolicObj3
obj