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
127
128
|
module Graphics.Glyph.ObjLoader where
import Control.Monad
import Data.Array
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Either
import Data.List.Split
import qualified Data.Map as M
import Debug.Trace
import Graphics.Glyph.BufferBuilder
import Graphics.Glyph.Util
import System.IO
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 splitOn "/" 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
|
