{-# LANGUAGE OverloadedStrings #-}

module Graphics.Formats.STL.Printer where

import qualified Data.ByteString            as BS
import           Data.ByteString.Builder    (Builder, byteString, charUtf8,
                                             floatDec, stringUtf8)
import           Data.List                  (intersperse)
import           Data.Text.Encoding         (encodeUtf8)

import           Graphics.Formats.STL.Types (STL (name, triangles),
                                             Triangle (Triangle), Vector)

-- | Convert an @STL@ value to a @Builder@, which can be converted to a
-- @ByteString@ with 'toLazyByteString'
textSTL :: STL -> Builder
textSTL :: STL -> Builder
textSTL STL
s = [Builder] -> Builder
vcat [ String -> Builder
stringUtf8 String
"solid " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder
byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ STL -> Text
name STL
s)
                   , [Builder] -> Builder
vcat ([Builder] -> Builder)
-> ([Triangle] -> [Builder]) -> [Triangle] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Triangle -> Builder) -> [Triangle] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Triangle -> Builder
triangle ([Triangle] -> Builder) -> [Triangle] -> Builder
forall a b. (a -> b) -> a -> b
$ STL -> [Triangle]
triangles STL
s
                   , String -> Builder
stringUtf8 String
"endsolid " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder
byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ STL -> Text
name STL
s)
                   ]

triangle :: Triangle -> Builder
triangle :: Triangle -> Builder
triangle (Triangle Maybe Vector
n (Vector
a, Vector
b, Vector
c)) =
    [Builder] -> Builder
vcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Builder
stringUtf8 String
"facet normal " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Vector -> Builder
maybeNormal Maybe Vector
n Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:
           (Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Builder -> Builder
indent Int
4) [ String -> Builder
stringUtf8 String
"outer loop"
                           , Int -> Builder -> Builder
indent Int
4 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Vector -> Builder
vertex Vector
a
                           , Int -> Builder -> Builder
indent Int
4 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Vector -> Builder
vertex Vector
b
                           , Int -> Builder -> Builder
indent Int
4 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Vector -> Builder
vertex Vector
c
                           , String -> Builder
stringUtf8 String
"endloop"
                           ]
         [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ [String -> Builder
stringUtf8 String
"endfacet"]

maybeNormal :: Maybe Vector -> Builder
maybeNormal :: Maybe Vector -> Builder
maybeNormal Maybe Vector
n = case Maybe Vector
n of
    Maybe Vector
Nothing -> Vector -> Builder
v3 (Float
0,Float
0,Float
0)
    Just Vector
n' -> Vector -> Builder
v3 Vector
n'

vertex :: Vector -> Builder
vertex :: Vector -> Builder
vertex Vector
v = String -> Builder
stringUtf8 String
"vertex " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Vector -> Builder
v3 Vector
v

v3 :: Vector -> Builder
v3 :: Vector -> Builder
v3 (Float
x, Float
y, Float
z) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
space [Float -> Builder
floatDec Float
x, Float -> Builder
floatDec Float
y, Float -> Builder
floatDec Float
z]
  where
    space :: Builder
space = Char -> Builder
charUtf8 Char
' '

indent :: Int -> Builder -> Builder
indent :: Int -> Builder -> Builder
indent Int
i Builder
bs = Builder
spaces Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bs where
  spaces :: Builder
spaces  = ByteString -> Builder
byteString (ByteString -> Builder)
-> (Word8 -> ByteString) -> Word8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ByteString
BS.replicate Int
i (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$ Word8
0x20 -- 0x20 is UTF-8 space

vcat :: [Builder] -> Builder
vcat :: [Builder] -> Builder
vcat [Builder]
bs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
newline [Builder]
bs where
  newline :: Builder
newline = Char -> Builder
charUtf8 Char
'\n'