{- 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 ([Triangle] -> TriangleMesh) -> [Triangle] -> TriangleMesh
forall a b. (a -> b) -> a -> b
$
    let
        boxes :: [Box3]
boxes = SymbolicObj3 -> Box3
getBox3 (SymbolicObj3 -> Box3) -> [SymbolicObj3] -> [Box3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SymbolicObj3]
objs
        boxedObjs :: [(Box3, SymbolicObj3)]
boxedObjs = [Box3] -> [SymbolicObj3] -> [(Box3, SymbolicObj3)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Box3]
boxes [SymbolicObj3]
objs

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

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