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
|
module Data.Obj3D.GL ( InterleavedObj
, interleavedArrayFormat
, indexArrayFormat
, interleaveObj
, makeInterleavedArrays
, bindInterleavedArrays
, drawObject
, GLuint
, ForeignPtr
) where
import Data.Obj3D
import Control.Arrow
import Control.Monad.State
import Data.Function (on)
import Data.List (genericIndex, sortBy)
import Data.Maybe
import Graphics.Rendering.OpenGL.GL (GLfloat, GLuint)
import Graphics.Rendering.OpenGL.GL.BeginEnd (PrimitiveMode(..))
import Graphics.Rendering.OpenGL.GL.VertexArrays (DataType(..), InterleavedArrays(..), interleavedArrays, drawElements)
import Foreign.ForeignPtr
import Foreign.Marshal.Array (pokeArray)
import Foreign.Ptr
import Foreign.Storable
import qualified Data.Map as M
data InterleavedObj = InterleavedObj
{ texCoordS :: GLfloat
, texCoordT :: GLfloat
, normalX :: GLfloat
, normalY :: GLfloat
, normalZ :: GLfloat
, vertexX :: GLfloat
, vertexY :: GLfloat
, vertexZ :: GLfloat
} deriving Show
instance Storable InterleavedObj where
sizeOf _ = 8 * sizeOf (undefined :: GLfloat)
alignment _ = alignment (undefined :: GLfloat)
peek _ = fail "Can't read InterleavedObj"
poke ptr obj = pokeArray (castPtr ptr) $ map ($ obj) [texCoordS, texCoordT, normalX, normalY, normalZ, vertexX, vertexY, vertexZ]
interleavedArrayFormat :: InterleavedArrays
interleavedArrayFormat = T2fN3fV3f
indexArrayFormat :: DataType
indexArrayFormat = UnsignedInt
type Interleaver a = State (Integer, M.Map FaceVertex Integer) a
getIndex :: FaceVertex -> Interleaver Integer
getIndex v = do
ix <- gets $ M.lookup v . snd
case ix of
Just i -> return i
Nothing -> do
i <- gets $ fst
modify $ (+1) *** (M.insert v i)
return i
makeVertexData :: ObjModel -> FaceVertex -> InterleavedObj
makeVertexData model (v, t, n) = InterleavedObj ts tt nx ny nz vx vy vz
where
(vx, vy, vz) = genericIndex (objVertices model) v
(ts, tt) = if isJust t then genericIndex (objTexCoords model) $ fromJust t else (0, 0)
(nx, ny, nz) = if isJust n then genericIndex (objNormals model) $ fromJust n else (0, 0, 0)
interleaveObj :: ObjModel -> ([InterleavedObj], [[Integer]])
interleaveObj model = evalState interleaveObj' (0, M.empty)
where
interleaveObj' :: Interleaver ([InterleavedObj], [[Integer]])
interleaveObj' = do
indices <- forM (objFaces model) $ mapM getIndex . concatMap (\(v1, v2, v3) -> [v1, v2, v3])
packedVertices <- gets $ map fst . sortBy (compare `on` snd) . M.toList . snd
return (map (makeVertexData model) packedVertices, indices)
makeInterleavedArrays :: ObjModel -> IO (ForeignPtr InterleavedObj, [(ForeignPtr GLuint, Int)])
makeInterleavedArrays model = do
let (vertexdata, indices) = interleaveObj model
interleavedptr <- mallocForeignPtrArray $ length vertexdata
withForeignPtr interleavedptr $ \ptr -> pokeArray ptr vertexdata
indexptrs <- forM indices $ \objindices -> do
indexptr <- mallocForeignPtrArray $ length objindices
withForeignPtr indexptr $ \ptr -> pokeArray ptr $ map fromIntegral objindices
return (indexptr, length objindices)
return (interleavedptr, indexptrs)
bindInterleavedArrays :: ForeignPtr InterleavedObj -> IO ()
bindInterleavedArrays obj = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0
drawObject :: ForeignPtr GLuint -> Int -> IO ()
drawObject buf l = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat
|
