summaryrefslogtreecommitdiffstats
path: root/src/Data/Obj3D.hs
blob: 4ef8151ad91485966da9b463eeffddeda3c9ad7e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
module Data.Obj3D ( ObjModel(..)
                  , processObj
                  , loadObj
                  , loadObjFile
                  , Vertex
                  , VertexNormal
                  , TexCoord
                  , FaceVertex
                  , Face
                  , SourceName
                  , ParseError
                  ) where

import Control.Arrow
import Control.Monad
import Data.Maybe

import Data.Obj3D.Parser

data ObjModel = ObjModel
    { objVertices  :: [Vertex]
    , objTexCoords :: [TexCoord]
    , objNormals   :: [VertexNormal]
    , objFaces     :: [[Face]]
    } deriving Show

processObj :: [ObjLine] -> ObjModel
processObj objlines = ObjModel
                      { objVertices  = vertices
                      , objTexCoords = texcoords
                      , objNormals   = normals
                      , objFaces     = faces
                      }
    where
      vertices = catMaybes $ map vertex objlines
      vertex (VertexLine v) = Just v
      vertex _              = Nothing
      
      texcoords = catMaybes $ map texcoord objlines
      texcoord (TexCoordLine v) = Just v
      texcoord _                 = Nothing
      
      
      normals = catMaybes $ map normal objlines
      normal (VertexNormalLine n) = Just n
      normal _                    = Nothing
      
      faces = filter (not . null) $ map (catMaybes . map face) $ splitLines objlines
      face (FaceLine f) = Just f
      face _            = Nothing
      
      splitLines [] = []
      splitLines l = let (l1, l2) = break isObjectLine l
                     in l1 : (if null l2 then [] else splitLines $ tail l2)
      
      isObjectLine (ObjectLine _) = True
      isObjectLine _              = False


loadObj :: SourceName -> String -> Either ParseError ObjModel
loadObj fname = right processObj . parseObj fname

loadObjFile :: SourceName -> IO (Either ParseError ObjModel)
loadObjFile fname = liftM (loadObj fname) $ readFile fname