{-# 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))
obj :: NormedTriangleMesh -> Text
obj :: NormedTriangleMesh -> Text
obj NormedTriangleMesh
mesh = Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder
vertcode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
normcode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
trianglecode
where
v :: ℝ3 -> Builder
v :: ℝ3 -> Builder
v (V3 ℝ
x ℝ
y ℝ
z) = Builder
"v " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
y Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
z Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
n :: ℝ3 -> Builder
n :: ℝ3 -> Builder
n (V3 ℝ
x ℝ
y ℝ
z) = Builder
"vn " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
y Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
z Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
verts :: [ℝ3]
verts = do
NormedTriangle ((ℝ3
a,ℝ3
_),(ℝ3
b,ℝ3
_),(ℝ3
c,ℝ3
_)) <- [NormedTriangle]
normedTriangles
[ℝ3
a,ℝ3
b,ℝ3
c]
norms :: [ℝ3]
norms = do
NormedTriangle ((ℝ3
_,ℝ3
a),(ℝ3
_,ℝ3
b),(ℝ3
_,ℝ3
c)) <- [NormedTriangle]
normedTriangles
[ℝ3
a,ℝ3
b,ℝ3
c]
vertcode :: Builder
vertcode = (ℝ3 -> Builder) -> [ℝ3] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ℝ3 -> Builder
v [ℝ3]
verts
normcode :: Builder
normcode = (ℝ3 -> Builder) -> [ℝ3] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ℝ3 -> Builder
n [ℝ3]
norms
trianglecode :: Builder
trianglecode :: Builder
trianglecode = [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ do
Int
n' <- (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)(Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
3)) [Int
0,Int
1 .. [NormedTriangle] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NormedTriangle]
normedTriangles Int -> Int -> Int
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'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
vtc :: Builder
vtc = Int -> Builder
buildInt (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
Builder -> [Builder]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> [Builder]) -> Builder -> [Builder]
forall a b. (a -> b) -> a -> b
$ Builder
"f " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
vta Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
vtb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
vtc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
normedTriangles :: [NormedTriangle]
normedTriangles = NormedTriangleMesh -> [NormedTriangle]
getNormedTriangles NormedTriangleMesh
mesh