From 67e1d2569baa712c40be26998dd3661ad8f3caa4 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <matthias@gamezock.de>
Date: Sun, 11 Apr 2010 20:45:20 +0200
Subject: Initial commit

---
 src/Data/Obj3D.hs | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)
 create mode 100644 src/Data/Obj3D.hs

(limited to 'src/Data/Obj3D.hs')

diff --git a/src/Data/Obj3D.hs b/src/Data/Obj3D.hs
new file mode 100644
index 0000000..c25deb8
--- /dev/null
+++ b/src/Data/Obj3D.hs
@@ -0,0 +1,63 @@
+module Data.Obj3D ( processObj
+                  , loadObj
+                  , loadObjFile
+                  , Vertex
+                  , VertexNormal
+                  , TexCoords
+                  , FaceVertex
+                  , Face
+                  , SourceName
+                  , ParseError
+                  ) where
+
+import Control.Arrow
+import Control.Monad
+import Data.Maybe
+
+import Data.Obj3D.Parser
+
+data ObjModel = ObjModel
+    { objVertices  :: [Vertex]
+    , objTexCoords :: [TexCoords]
+    , 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 (TexCoordsLine 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
-- 
cgit v1.2.3