1 files changed, 30 insertions, 13 deletions

diff --git a/LoadMesh.hs b/LoadMesh.hs
index cda6349..d8ce42b 100644
--- a/LoadMesh.hs
+++ b/LoadMesh.hs
@@ -126,8 +126,6 @@ uploadOBJToGPU :: Maybe BoundingBox -> MeshData -> IO ([MaterialMesh GPUMesh],Ma
 uploadOBJToGPU scalebb (subModels,(mtlLib,objpath)) = do
     let meshbb = foldMap (attribBoundingBox . mAttributes . materialMesh) subModels :: BoundingBox
         m = maybe (ident 4) (scaleWithin meshbb) scalebb
-    -- BoundingBox {minX = -6.44698, maxX = 6.44698, minY = 0.0, maxY = 1.0e9, minZ = -0.768655, maxZ = 1.0e8}
-    -- BoundingBox {minX = -6.44698, maxX = 6.44698, minY = 0.0, maxY = 18.2027, minZ = -0.768655, maxZ = 2.238049}
     putStrLn $ show meshbb
     gpuSubModels <- forM subModels $ \matmesh -> do
         a <- LambdaCubeGL.uploadMeshToGPU (transformMesh m (materialMesh matmesh))
@@ -204,25 +202,44 @@ objSpan obj = case Map.elems (objAttributes obj) of
         _                             -> Mask [(0,1)]
 
 
-searchMaterial :: V.Vector (Map Text (ObjMaterial, TextureData))
-                  -> (Int, Text)
-                  -> Maybe (ObjMaterial, TextureData)
+searchMaterial
+    :: V.Vector (Map Text (ObjMaterial, TextureData)) -- ^ Some tail end of this vector will be searched.
+    -> (Int, Text)                                    -- ^ Size of tail and material name to search for.
+    -> Maybe (ObjMaterial, TextureData)
 searchMaterial mtlLib (count,name) = foldr go id (V.drop (V.length mtlLib - count) mtlLib) Nothing
  where
     go m f r = case Map.lookup name m of
         Nothing -> f r
         x       -> x :: Maybe (ObjMaterial,TextureData)
 
-addOBJToObjectArray :: GLStorage -> String -> [MaterialMesh GPUMesh] -> V.Vector (Map Text (ObjMaterial,TextureData))
+addOBJToObjectArray :: GLStorage -> String
+                                 -> [MaterialMesh GPUMesh]
+                                 -> V.Vector (Map Text (ObjMaterial,TextureData))
                                  -> IO [MaskableObject]
 addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \matmesh -> do
-  obj <- LambdaCubeGL.addMeshToObjectArray storage slotName ["diffuseTexture","diffuseColor"] (materialMesh matmesh)
-         -- diffuseTexture and diffuseColor values can change on each model
-  case materialName matmesh >>= searchMaterial mtlLib of
-    Nothing -> return ()
-    Just (ObjMaterial{..},t) -> LC.updateObjectUniforms obj $ do
-      "diffuseTexture" @= return t -- set model's diffuse texture
-      "diffuseColor" @= let (r,g,b) = mtl_Kd in return (V4 r g b mtl_Tr)
+  obj <- case materialName matmesh >>= searchMaterial mtlLib of
+    Nothing -> do
+        let slotnm = slotName ++ "0"
+        obj <- LambdaCubeGL.addMeshToObjectArray storage
+                                                 slotnm
+                                                 [ "diffuseTexture"
+                                                 , "diffuseColor"
+                                                 , "specularReflectivity"]
+                                                 (materialMesh matmesh)
+        return obj
+    Just (ObjMaterial{..},t) -> do
+        let slotnm = slotName ++ show (if 0 <= mtl_illum && mtl_illum <= 2 then mtl_illum else 2)
+        obj <- LambdaCubeGL.addMeshToObjectArray storage
+                                                 slotnm
+                                                 [ "diffuseTexture"
+                                                 , "diffuseColor"
+                                                 , "specularReflectivity"]
+                                                 (materialMesh matmesh)
+        LC.updateObjectUniforms obj $ do
+          "diffuseTexture" @= return t -- set model's diffuse texture
+          "diffuseColor" @= let (r,g,b) = mtl_Kd in return (V4 r g b mtl_Tr)
+          "specularReflectivity" @= let (r,g,b) = mtl_Ks in return (V4 r g b mtl_Ns)
+        return obj
   let matmask = maybe Map.empty (`Map.singleton` objSpan obj)
                       (fmap (\(c,n) -> "m:" <> pack (show c) <> ":" <> n) $ materialName matmesh)
   return $ MaskableObject obj (matmask `Map.union` materialMasks matmesh)