{-# LANGUAGE LambdaCase     #-}
{-# LANGUAGE NamedFieldPuns #-}
module Graphics.GPipe.Engine.STL (mustLoadSTL) where

import qualified Graphics.Formats.STL       as STL
import           Graphics.Formats.STL.Types (STL (..))
import           Graphics.GPipe             (V3 (..), cross, normalize)


mustLoadSTL :: FilePath -> IO [(V3 Float, V3 Float)]
mustLoadSTL :: FilePath -> IO [(V3 Float, V3 Float)]
mustLoadSTL = (STL -> [(V3 Float, V3 Float)])
-> IO STL -> IO [(V3 Float, V3 Float)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap STL -> [(V3 Float, V3 Float)]
stlToMesh (IO STL -> IO [(V3 Float, V3 Float)])
-> (FilePath -> IO STL) -> FilePath -> IO [(V3 Float, V3 Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO STL
STL.mustLoadSTL


stlToMesh :: STL -> [(V3 Float, V3 Float)]
stlToMesh :: STL -> [(V3 Float, V3 Float)]
stlToMesh STL{[Triangle]
triangles :: STL -> [Triangle]
triangles :: [Triangle]
triangles} = [V3 Float] -> [V3 Float] -> [(V3 Float, V3 Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [V3 Float]
positions [V3 Float]
normals
  where
    toV3 :: STL.Vector -> V3 Float
    toV3 :: Vector -> V3 Float
toV3 (Float
x, Float
y, Float
z) = Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
x Float
y Float
z

    positions :: [V3 Float]
positions =
        (Triangle -> [V3 Float]) -> [Triangle] -> [V3 Float]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\STL.Triangle{vertices :: Triangle -> (Vector, Vector, Vector)
STL.vertices=(Vector
v1, Vector
v2, Vector
v3)} ->
            [Vector -> V3 Float
toV3 Vector
v1, Vector -> V3 Float
toV3 Vector
v2, Vector -> V3 Float
toV3 Vector
v3]) [Triangle]
triangles

    normal :: (V3 a, V3 a, V3 a) -> V3 a
normal (V3 a
a, V3 a
b, V3 a
c) =
        V3 a -> V3 a
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize (V3 a -> V3 a -> V3 a
forall a. Num a => V3 a -> V3 a -> V3 a
cross V3 a
edge1 V3 a
edge2)
      where
        edge1 :: V3 a
edge1 = V3 a
b V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
- V3 a
a
        edge2 :: V3 a
edge2 = V3 a
c V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
- V3 a
b

    normals :: [V3 Float]
normals = ((Triangle -> [V3 Float]) -> [Triangle] -> [V3 Float]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [Triangle]
triangles) ((Triangle -> [V3 Float]) -> [V3 Float])
-> (Triangle -> [V3 Float]) -> [V3 Float]
forall a b. (a -> b) -> a -> b
$ \case
        STL.Triangle{normal :: Triangle -> Maybe Vector
STL.normal=Just Vector
n}         -> Int -> V3 Float -> [V3 Float]
forall a. Int -> a -> [a]
replicate Int
3 (V3 Float -> [V3 Float]) -> V3 Float -> [V3 Float]
forall a b. (a -> b) -> a -> b
$ Vector -> V3 Float
toV3 Vector
n
        STL.Triangle{vertices :: Triangle -> (Vector, Vector, Vector)
STL.vertices=(Vector
v1, Vector
v2, Vector
v3)} -> Int -> V3 Float -> [V3 Float]
forall a. Int -> a -> [a]
replicate Int
3 (V3 Float -> [V3 Float]) -> V3 Float -> [V3 Float]
forall a b. (a -> b) -> a -> b
$ (V3 Float, V3 Float, V3 Float) -> V3 Float
forall a. (Floating a, Epsilon a) => (V3 a, V3 a, V3 a) -> V3 a
normal (Vector -> V3 Float
toV3 Vector
v1, Vector -> V3 Float
toV3 Vector
v2, Vector -> V3 Float
toV3 Vector
v3)