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

-- FIXME: describe why we need this.
{-# LANGUAGE OverloadedStrings #-}

module Graphics.Implicit.Export.NormedTriangleMeshFormats (obj) where

import Prelude(($), fmap, (+), (.), (*), length, (-), pure, (<>))

import Graphics.Implicit.Definitions (NormedTriangle(NormedTriangle), NormedTriangleMesh(getNormedTriangles), ℝ3)
import Graphics.Implicit.Export.TextBuilderUtils (Text, Builder, toLazyText, bf, buildInt)

import Data.Foldable (fold, foldMap)
import Linear (V3(V3))

-- | Generate a .obj format file from a NormedTriangleMesh
--   see: https://en.wikipedia.org/wiki/Wavefront_.obj_file
obj :: NormedTriangleMesh -> Text
obj :: NormedTriangleMesh -> Text
obj NormedTriangleMesh
mesh = Builder -> Text
toLazyText forall a b. (a -> b) -> a -> b
$ Builder
vertcode forall a. Semigroup a => a -> a -> a
<> Builder
normcode forall a. Semigroup a => a -> a -> a
<> Builder
trianglecode
    where
        -- A vertex line; v (0.0, 0.0, 1.0) = "v 0.0 0.0 1.0\n"
        v :: ℝ3 -> Builder
        v :: ℝ3 -> Builder
v (V3 ℝ
x ℝ
y ℝ
z) = Builder
"v "  forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
x forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
y forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
z forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
        -- A normal line; n (0.0, 0.0, 1.0) = "vn 0.0 0.0 1.0\n"
        n :: ℝ3 -> Builder
        n :: ℝ3 -> Builder
n (V3 ℝ
x ℝ
y ℝ
z) = Builder
"vn " forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
x forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
y forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
z forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
        verts :: [ℝ3]
verts = do
            --  Extract the vertices for each triangle.
            --  recall that a normed triangle is of the form ((vert, norm), ...)
            NormedTriangle ((ℝ3
a,ℝ3
_),(ℝ3
b,ℝ3
_),(ℝ3
c,ℝ3
_)) <- [NormedTriangle]
normedTriangles
            -- The vertices from each triangle take up 3 positions in the resulting list
            [ℝ3
a,ℝ3
b,ℝ3
c]
        norms :: [ℝ3]
norms = do
            -- extract the normals for each triangle
            NormedTriangle ((ℝ3
_,ℝ3
a),(ℝ3
_,ℝ3
b),(ℝ3
_,ℝ3
c)) <- [NormedTriangle]
normedTriangles
            -- The normals from each triangle take up 3 positions in the resulting list
            [ℝ3
a,ℝ3
b,ℝ3
c]
        vertcode :: Builder
vertcode = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ℝ3 -> Builder
v [ℝ3]
verts
        normcode :: Builder
normcode = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ℝ3 -> Builder
n [ℝ3]
norms
        trianglecode :: Builder
        trianglecode :: Builder
trianglecode = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ do
            Int
n' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Num a => a -> a -> a
+Int
1)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. Num a => a -> a -> a
*Int
3)) [Int
0,Int
1 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [NormedTriangle]
normedTriangles forall a. Num a => a -> a -> a
-Int
1]
            let
                vta :: Builder
vta = Int -> Builder
buildInt  Int
n'
                vtb :: Builder
vtb = Int -> Builder
buildInt (Int
n'forall a. Num a => a -> a -> a
+Int
1)
                vtc :: Builder
vtc = Int -> Builder
buildInt (Int
n'forall a. Num a => a -> a -> a
+Int
2)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Builder
"f " forall a. Semigroup a => a -> a -> a
<> Builder
vta forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<> Builder
vtb forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<> Builder
vtc forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
        normedTriangles :: [NormedTriangle]
normedTriangles = NormedTriangleMesh -> [NormedTriangle]
getNormedTriangles NormedTriangleMesh
mesh