Better handle missing material lib.

2 files changed, 15 insertions, 3 deletions

diff --git a/LoadMesh.hs b/LoadMesh.hs
index cd7a8ad..702f2c9 100644
--- a/LoadMesh.hs
+++ b/LoadMesh.hs
@@ -12,6 +12,7 @@ import MtlParser
 
 import Control.Arrow
 import Control.Monad
+import Data.Functor
 import Data.Int
 import Data.List as List
 import Data.Maybe
@@ -60,7 +61,9 @@ loadOBJ :: String -> IO (Either String MeshData)
 loadOBJ fname = L.readFile fname >>= \bs -> do
     let  obj@OBJ{..} = Wavefront.parse bs
     -- load materials
-    mtlLib <- mapM (readMtlWithFallback . relativeFrom fname . unpack) objMtlLibs
+    mtlLib <- if V.null objMtlLibs
+                then return $ V.singleton (Map.singleton "" $ newMaterial "")
+                else mapM (readMtlWithFallback . relativeFrom fname . unpack) objMtlLibs
     return $ Right MeshData
         { matMeshes = objToMesh obj
         , matLib    = (mtlLib,fname)
@@ -175,7 +178,10 @@ uploadMtlLib (mtlLib,objpath) = do
     Right img -> LC.uploadTexture2DToGPU img
   whiteTex <- LC.uploadTexture2DToGPU whiteImage
   -- pair textures and materials
-  return $ fmap (\a -> (a, maybe whiteTex (fromMaybe checkerTex . flip Map.lookup textureLib) . mtl_map_Kd $ a)) <$> mtlLib
+  -- type MtlLib = Map Text ObjMaterial
+  let withTextureData mat = (,) mat $ maybe whiteTex (fromMaybe checkerTex . flip Map.lookup textureLib)
+                                    $ mtl_map_Kd mat
+  return $ fmap withTextureData <$> mtlLib
 
 vecLocation :: Location -> StorableV.Vector Float
 vecLocation (Location x y z w) = StorableV.fromList [x,y,z,w]
@@ -259,13 +265,18 @@ addOBJToObjectArray :: GLStorage -> String
 addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \matmesh -> do
   obj <- case materialName matmesh >>= searchMaterial mtlLib of
     Nothing -> do
-        let slotnm = slotName ++ "0"
+        let slotnm = slotName ++ "1"
         obj <- LambdaCubeGL.addMeshToObjectArray storage
                                                  slotnm
                                                  [ "diffuseTexture"
                                                  , "diffuseColor"
                                                  , "specularReflectivity"]
                                                  (materialMesh matmesh)
+        let (white,whiteTex) = (mtlLib V.! 0) Map.! ""
+        LC.updateObjectUniforms obj $ do
+          "diffuseTexture" @= return whiteTex -- set model's diffuse texture
+          "diffuseColor" @= let (r,g,b) = mtl_Kd white in return $ V4 r g b (mtl_Tr white)
+          "specularReflectivity" @= let (r,g,b) = mtl_Ks white in return $ V4 r g b (mtl_Ns white)
         return obj
     Just (ObjMaterial{..},t) -> do
         let slotnm = slotName ++ show (if 0 <= mtl_illum && mtl_illum <= 2 then mtl_illum else 2)
diff --git a/MtlParser.hs b/MtlParser.hs
index ed952d0..a59c0eb 100644
--- a/MtlParser.hs
+++ b/MtlParser.hs
@@ -4,6 +4,7 @@ module MtlParser
   , parseMtl
   , readMtl
   , readMtlWithFallback
+  , newMaterial
   ) where
 
 import Data.Map (Map)