1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module LoadMesh where
import LambdaCube.GL as LambdaCubeGL -- renderer
import LambdaCube.GL.Mesh as LambdaCubeGL
import MtlParser
import Control.Monad
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Vector as V
import qualified Data.ByteString as SB
import Data.Text (unpack,Text)
import Data.List (groupBy,nub)
import Codec.Picture as Juicy
import Codec.Wavefront
import Data.Aeson
type MeshData = ([(Mesh,Maybe Text)],MtlLib)
loadOBJ :: String -> IO (Either String MeshData)
loadOBJ fname = fromFile fname >>= \case -- load geometry
Left err -> putStrLn err >> return (Left err)
Right obj@WavefrontOBJ{..} -> do
-- load materials
mtlLib <- mconcat . V.toList <$> mapM (readMtl . unpack) objMtlLibs
return $ Right (objToMesh obj,mtlLib)
uploadOBJToGPU :: MeshData -> IO ([(GPUMesh, Maybe Text)], MtlLib)
uploadOBJToGPU (subModels,mtlLib) = do
gpuSubModels <- forM subModels $ \(mesh,mat) -> LambdaCubeGL.uploadMeshToGPU mesh >>= \a -> return (a,mat)
return (gpuSubModels,mtlLib)
uploadMtlLib :: MtlLib -> IO (Map Text (ObjMaterial,TextureData))
uploadMtlLib mtlLib = do
-- collect used textures
let usedTextures = nub . concatMap (maybeToList . mtl_map_Kd) $ Map.elems mtlLib
whiteImage = Juicy.ImageRGB8 $ Juicy.generateImage (\_ _ -> Juicy.PixelRGB8 255 255 255) 1 1
checkerImage = Juicy.ImageRGB8 $ Juicy.generateImage (\x y -> if mod (x + y) 2 == 0 then Juicy.PixelRGB8 0 0 0 else Juicy.PixelRGB8 255 255 0) 2 2
checkerTex <- LambdaCubeGL.uploadTexture2DToGPU checkerImage
-- load images and upload to gpu
textureLib <- forM (Map.fromList $ zip usedTextures usedTextures) $ \fname -> Juicy.readImage fname >>= \case
Left err -> putStrLn err >> return checkerTex
Right img -> LambdaCubeGL.uploadTexture2DToGPU img
whiteTex <- LambdaCubeGL.uploadTexture2DToGPU whiteImage
-- pair textures and materials
return $ (\a -> (a, maybe whiteTex (fromMaybe checkerTex . flip Map.lookup textureLib) . mtl_map_Kd $ a)) <$> mtlLib
objToMesh :: WavefrontOBJ -> [(Mesh,Maybe Text)]
objToMesh WavefrontOBJ{..} = [(toMesh faceGroup, elMtl . head $ faceGroup) | faceGroup <- faces] where
faces = groupBy (\a b -> elMtl a == elMtl b) (V.toList objFaces)
toMesh l = Mesh
{ mAttributes = Map.fromList
[ ("position", A_V4F position)
, ("normal", A_V3F normal)
, ("uvw", A_V3F texcoord)
]
, mPrimitive = P_Triangles
} where
triangulate (Triangle a b c) = [a,b,c]
triangulate (Quad a b c d) = [a,b,c, c,d,a]
triangulate (Face a b c l) = a : b : c : concatMap (\(x,y) -> [a,x,y]) (zip (c:l) l) -- should work for convex polygons without holes
defaultPosition = Location 0 0 0 0
defaultNormal = Normal 0 0 0
defaultTexCoord = TexCoord 0 0 0
v !- i = v V.!? (i-1)
toVertex FaceIndex{..} = ( let Location x y z w = fromMaybe defaultPosition (objLocations !- faceLocIndex) in V4 x y z w
, let Normal x y z = fromMaybe defaultNormal ((objNormals !-) =<< faceNorIndex) in V3 x y z
, let TexCoord x y z = fromMaybe defaultTexCoord ((objTexCoords !-) =<< faceTexCoordIndex) in V3 x y z
)
(position,normal,texcoord) = V.unzip3 . V.concat . map (V.fromList . map toVertex . triangulate . elValue) $ l
|
