From e0698ec0a20507442fc448a293dd68796c7c1b97 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Mon, 29 Jul 2019 18:27:14 -0400
Subject: Compute face normals when file does not provide vertex normals.

---
 LoadMesh.hs | 37 ++++++++++++++++++++++++++++---------
 1 file changed, 28 insertions(+), 9 deletions(-)

diff --git a/LoadMesh.hs b/LoadMesh.hs
index 702f2c9..bb0f5b0 100644
--- a/LoadMesh.hs
+++ b/LoadMesh.hs
@@ -193,6 +193,22 @@ objToCurveData OBJ{..} = CurveData
     , curveMax = V.length objLocations
     }
 
+faceNormal :: [Location] -> Normal
+faceNormal (Location ax ay az _:Location bx by bz _:Location cx cy cz _:_)
+    = Normal nx ny nz
+ where
+    [nx,ny,nz] = toList $ nrml $ cross x y
+    a = fromList [ax,ay,az]
+    b = fromList [bx,by,bz]
+    c = fromList [cx,cy,cz]
+    x = b - a
+    y = c - b
+faceNormal _ = Normal 0 1 0
+
+nrml :: (Linear t c, Fractional t, Normed (c t)) => c t -> c t
+nrml v = scale (1 / realToFrac (norm_2 v)) v
+
+
 objToMesh :: WavefrontOBJ -> [MaterialMesh Mesh]
 objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ]
  where
@@ -200,6 +216,9 @@ objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ]
   toMesh l = MaterialMesh mesh mtl gs
      where
         mtl = elMtl $ head l
+        computeNormal fs = case 1 {- mtl_illum (lookupMat mtl) -} of
+            -- 0 -> Normal 0 1 0
+            _ -> faceNormal $ mapMaybe ((objLocations !-) . faceLocIndex) fs
         mesh = Mesh { mAttributes   = Map.fromList
                         [ ("position",  A_V4F position)
                         , ("normal",    A_V3F normal)
@@ -208,15 +227,15 @@ objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ]
                     , mPrimitive    = P_Triangles
                     }
         defaultPosition = Location 0 0 0 0
-        defaultNormal = Normal 0 1 0
         defaultTexCoord = TexCoord 0 0 0
         v !- i = v V.!? i
-        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
-                                 )
-        (gs,fs) = elementIndices l
-        (positions,normals,texcoords) = unzip3 $ map toVertex fs
+        toVertex defaultNormal 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
+            )
+        (gs,fss) = elementIndices l
+        (positions,normals,texcoords) = unzip3 $ concatMap (\fs -> map (toVertex $ computeNormal fs) fs) fss
         position = V.fromList positions
         normal = V.fromList normals
         texcoord = V.fromList texcoords
@@ -226,8 +245,8 @@ 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
 
-elementIndices :: [Element Face] -> (Map Text Mask, [FaceIndex])
-elementIndices els = (spans,concatMap snd ts)
+elementIndices :: [Element Face] -> (Map Text Mask, [[FaceIndex]])
+elementIndices els = (spans,map snd ts)
  where
     ts = map ((elGroups &&& elValue) . fmap triangulate) els
     rs = List.scanl' go ((0,0),[]) ts -- scanl :: (b -> a -> b) -> b -> [a] -> [b]
-- 
cgit v1.2.3