summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--LoadMesh.hs37
1 files 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
193 , curveMax = V.length objLocations 193 , curveMax = V.length objLocations
194 } 194 }
195 195
196faceNormal :: [Location] -> Normal
197faceNormal (Location ax ay az _:Location bx by bz _:Location cx cy cz _:_)
198 = Normal nx ny nz
199 where
200 [nx,ny,nz] = toList $ nrml $ cross x y
201 a = fromList [ax,ay,az]
202 b = fromList [bx,by,bz]
203 c = fromList [cx,cy,cz]
204 x = b - a
205 y = c - b
206faceNormal _ = Normal 0 1 0
207
208nrml :: (Linear t c, Fractional t, Normed (c t)) => c t -> c t
209nrml v = scale (1 / realToFrac (norm_2 v)) v
210
211
196objToMesh :: WavefrontOBJ -> [MaterialMesh Mesh] 212objToMesh :: WavefrontOBJ -> [MaterialMesh Mesh]
197objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ] 213objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ]
198 where 214 where
@@ -200,6 +216,9 @@ objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ]
200 toMesh l = MaterialMesh mesh mtl gs 216 toMesh l = MaterialMesh mesh mtl gs
201 where 217 where
202 mtl = elMtl $ head l 218 mtl = elMtl $ head l
219 computeNormal fs = case 1 {- mtl_illum (lookupMat mtl) -} of
220 -- 0 -> Normal 0 1 0
221 _ -> faceNormal $ mapMaybe ((objLocations !-) . faceLocIndex) fs
203 mesh = Mesh { mAttributes = Map.fromList 222 mesh = Mesh { mAttributes = Map.fromList
204 [ ("position", A_V4F position) 223 [ ("position", A_V4F position)
205 , ("normal", A_V3F normal) 224 , ("normal", A_V3F normal)
@@ -208,15 +227,15 @@ objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ]
208 , mPrimitive = P_Triangles 227 , mPrimitive = P_Triangles
209 } 228 }
210 defaultPosition = Location 0 0 0 0 229 defaultPosition = Location 0 0 0 0
211 defaultNormal = Normal 0 1 0
212 defaultTexCoord = TexCoord 0 0 0 230 defaultTexCoord = TexCoord 0 0 0
213 v !- i = v V.!? i 231 v !- i = v V.!? i
214 toVertex FaceIndex{..} = ( let Location x y z w = fromMaybe defaultPosition (objLocations !- faceLocIndex) in V4 x y z w 232 toVertex defaultNormal FaceIndex{..} =
215 , let Normal x y z = fromMaybe defaultNormal ((objNormals !-) =<< faceNorIndex) in V3 x y z 233 ( let Location x y z w = fromMaybe defaultPosition (objLocations !- faceLocIndex) in V4 x y z w
216 , let TexCoord x y z = fromMaybe defaultTexCoord ((objTexCoords !-) =<< faceTexCoordIndex) in V3 x y z 234 , let Normal x y z = fromMaybe defaultNormal ((objNormals !-) =<< faceNorIndex) in V3 x y z
217 ) 235 , let TexCoord x y z = fromMaybe defaultTexCoord ((objTexCoords !-) =<< faceTexCoordIndex) in V3 x y z
218 (gs,fs) = elementIndices l 236 )
219 (positions,normals,texcoords) = unzip3 $ map toVertex fs 237 (gs,fss) = elementIndices l
238 (positions,normals,texcoords) = unzip3 $ concatMap (\fs -> map (toVertex $ computeNormal fs) fs) fss
220 position = V.fromList positions 239 position = V.fromList positions
221 normal = V.fromList normals 240 normal = V.fromList normals
222 texcoord = V.fromList texcoords 241 texcoord = V.fromList texcoords
@@ -226,8 +245,8 @@ triangulate (Triangle a b c) = [a,b,c]
226triangulate (Quad a b c d) = [a,b,c, c,d,a] 245triangulate (Quad a b c d) = [a,b,c, c,d,a]
227triangulate (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 246triangulate (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
228 247
229elementIndices :: [Element Face] -> (Map Text Mask, [FaceIndex]) 248elementIndices :: [Element Face] -> (Map Text Mask, [[FaceIndex]])
230elementIndices els = (spans,concatMap snd ts) 249elementIndices els = (spans,map snd ts)
231 where 250 where
232 ts = map ((elGroups &&& elValue) . fmap triangulate) els 251 ts = map ((elGroups &&& elValue) . fmap triangulate) els
233 rs = List.scanl' go ((0,0),[]) ts -- scanl :: (b -> a -> b) -> b -> [a] -> [b] 252 rs = List.scanl' go ((0,0),[]) ts -- scanl :: (b -> a -> b) -> b -> [a] -> [b]