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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
module Graphics.Glyph.ObjLoader where
import Graphics.Glyph.BufferBuilder
import Graphics.Glyph.Util
import Debug.Trace
import Control.Monad
import Data.Either
import Data.String.Utils
import Data.Array
import System.IO
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
data ObjectFile a = ObjectFile [ObjectStatement a]
data ObjectStatement a =
Nop |
VertexStatement (a,a,a) |
TextureStatement (a,a) |
VertexNormalStatement (a,a,a) |
UseMaterialStatement (String) |
MaterialLibraryStatement String |
FaceStatement [(Int,Int,Int)] deriving Show
foldl2 :: a -> [b] -> (a -> b -> a) -> a
foldl2 a b c = foldl c a b
isNop :: ObjectStatement a -> Bool
isNop x = case x of
Nop -> True
_ -> False
isVertex :: ObjectStatement a -> Bool
isVertex (VertexStatement _) = True
isVertex _ = False
isNormal :: ObjectStatement a -> Bool
isNormal (VertexNormalStatement _) = True
isNormal _ = False
isTexture :: ObjectStatement a -> Bool
isTexture (TextureStatement _) = True
isTexture _ = False
basicBuildObject :: (Floating b, IsModelBuilder b a) => ObjectFile b -> a ()
basicBuildObject (ObjectFile list) =
let fromList lst = listArray (0,length lst-1) lst in
-- Set up the lists as arrays for fast access
let vertexList = fromList $ map (\stmt ->
case stmt of
(VertexStatement v) -> v
_ -> (0,0,0)) (filter isVertex list) in
let normalList = fromList $ map (\stmt ->
case stmt of
(VertexNormalStatement v) -> v
_ -> (0,0,0)) (filter isNormal list) in
let textureList = fromList $ map (\stmt ->
case stmt of
(TextureStatement v) -> v
_ -> (0,0)) (filter isTexture list) in
forM_ list $ \stmt ->
case stmt of
(FaceStatement arr) ->
forM_ arr $ \(a,b,c) -> do
when (c >= 0) (uncurry3 plotNormal $ normalList ! (c-1))
when (b >= 0) (uncurry plotTexture $ textureList ! (b-1))
when (a >= 0) (uncurry3 plotVertex3 $ vertexList ! (a-1))
_ -> return ()
loadObjFromBytestring :: (Read b) => L.ByteString -> ([String], ObjectFile b)
loadObjFromBytestring _contents =
let contents::[L.ByteString] ; contents = C.split '\n' _contents in
let mys2n str = case str of
"" -> -1
_ -> read str in
let s2t s = case split "/" s of
[a,b,c] -> Just (mapT3 mys2n (a,b,c))
[a,b] -> Just (mapT3 mys2n (a,b,""))
[a] -> Just (mapT3 mys2n (a,"",""))
_ -> Nothing in
let compiled =
map (\(num,line) -> case words $ C.unpack line of
[] -> Right Nop -- This is an empty line
(('#':_):_) -> Right Nop -- This is a comment, so use a 'nop'
("o":_) -> Right Nop -- Not really of use
["v",x,y,z] -> Right $ VertexStatement ( (read x), (read y), (read z))
["vt",x,y] -> Right $ TextureStatement ( (read x), (read y))
["vn",x,y,z] -> Right $ VertexNormalStatement ( (read x), (read y), (read z))
["usemtl", mtl] -> Right $ UseMaterialStatement mtl
["mtllib", lib] -> Right $ MaterialLibraryStatement lib
("f":_tail) -> case mapM s2t _tail of
Just lst -> Right $ FaceStatement lst
_ -> Left $ foldl (++) "" ["Syntax error in face value on line ", show num, " `", C.unpack line, "'" ]
_ -> Left $ foldl (++) "" ["Unrecognized Sequence on line ", show num, " `", C.unpack line, "'" ]
) (zip [(1::Int)..] contents) in
( lefts compiled, ObjectFile (filter (not.isNop) $ rights compiled) )
loadObjFromHandle :: (Read b) => Handle -> IO ([String], ObjectFile b)
loadObjFromHandle = loadObjFromHandleWithFilter id
loadObjFromHandleWithFilter :: (Read b) => (L.ByteString -> L.ByteString) -> Handle -> IO ([String], ObjectFile b)
loadObjFromHandleWithFilter _filter handle =
liftM (loadObjFromBytestring . _filter) (L.hGetContents handle)
loadObjFile :: (Read b) => FilePath -> IO ([String], ObjectFile b)
loadObjFile = loadObjFileWithFilter id
loadObjFileWithFilter :: (Read b) => (L.ByteString -> L.ByteString) -> FilePath -> IO ([String], ObjectFile b)
loadObjFileWithFilter filt path = loadObjFromHandleWithFilter filt =<< openFile path ReadMode
|
