diff options
Diffstat (limited to 'LoadMesh.hs')
-rw-r--r-- | LoadMesh.hs | 37 |
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 | ||
196 | faceNormal :: [Location] -> Normal | ||
197 | faceNormal (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 | ||
206 | faceNormal _ = Normal 0 1 0 | ||
207 | |||
208 | nrml :: (Linear t c, Fractional t, Normed (c t)) => c t -> c t | ||
209 | nrml v = scale (1 / realToFrac (norm_2 v)) v | ||
210 | |||
211 | |||
196 | objToMesh :: WavefrontOBJ -> [MaterialMesh Mesh] | 212 | objToMesh :: WavefrontOBJ -> [MaterialMesh Mesh] |
197 | objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ] | 213 | objToMesh 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] | |||
226 | triangulate (Quad a b c d) = [a,b,c, c,d,a] | 245 | triangulate (Quad a b c d) = [a,b,c, c,d,a] |
227 | 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 | 246 | 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 |
228 | 247 | ||
229 | elementIndices :: [Element Face] -> (Map Text Mask, [FaceIndex]) | 248 | elementIndices :: [Element Face] -> (Map Text Mask, [[FaceIndex]]) |
230 | elementIndices els = (spans,concatMap snd ts) | 249 | elementIndices 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] |