neocturne/obj-model-opengl
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Renamed some types

Browse source
This commit is contained in:
Matthias Schiffer 2010-04-12 02:31:39 +02:00
parent c4d5b82dd7
commit f903ac5208
1 changed files with 20 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
src/Data/Obj3D/GL.hs
View file

@ -1,12 +1,11 @@
module Data.Obj3D.GL ( InterleavedObj module Data.Obj3D.GL ( Interleaved
, InterleavedObj
, interleavedArrayFormat , interleavedArrayFormat
, indexArrayFormat , indexArrayFormat
, interleaveObj , interleaveObj
, makeInterleavedArrays , makeInterleavedArrays
, bindInterleavedArrays , bindInterleavedArrays
, drawObject , drawObject
, GLuint
, ForeignPtr
) where ) where
import Data.Obj3D import Data.Obj3D
@ -27,7 +26,7 @@ import Foreign.Storable
import qualified Data.Map as M import qualified Data.Map as M
data InterleavedObj = InterleavedObj data Interleaved = Interleaved
{ texCoordS :: GLfloat { texCoordS :: GLfloat
, texCoordT :: GLfloat , texCoordT :: GLfloat
, normalX :: GLfloat , normalX :: GLfloat
@ -38,24 +37,24 @@ data InterleavedObj = InterleavedObj
, vertexZ :: GLfloat , vertexZ :: GLfloat
} deriving Show } deriving Show
instance Storable InterleavedObj where instance Storable Interleaved where
sizeOf _ = 8 * sizeOf (undefined :: GLfloat) sizeOf _ = 8 * sizeOf (undefined :: GLfloat)
alignment _ = alignment (undefined :: GLfloat) alignment _ = alignment (undefined :: GLfloat)
peek _ = fail "Can't read InterleavedObj" peek _ = fail "Can't read Interleaved"
poke ptr obj = pokeArray (castPtr ptr) $ map ($ obj) [texCoordS, texCoordT, normalX, normalY, normalZ, vertexX, vertexY, vertexZ] poke ptr obj = pokeArray (castPtr ptr) $ map ($ obj) [texCoordS, texCoordT, normalX, normalY, normalZ, vertexX, vertexY, vertexZ]
type InterleavedObj = (ForeignPtr Interleaved, [(ForeignPtr GLuint, Int)])
type Interleaver a = State (Integer, M.Map FaceVertex Integer) a
interleavedArrayFormat :: InterleavedArrays interleavedArrayFormat :: InterleavedArrays
interleavedArrayFormat = T2fN3fV3f interleavedArrayFormat = T2fN3fV3f
indexArrayFormat :: DataType indexArrayFormat :: DataType
indexArrayFormat = UnsignedInt indexArrayFormat = UnsignedInt
type Interleaver a = State (Integer, M.Map FaceVertex Integer) a
getIndex :: FaceVertex -> Interleaver Integer getIndex :: FaceVertex -> Interleaver Integer
getIndex v = do getIndex v = do
ix <- gets $ M.lookup v . snd ix <- gets $ M.lookup v . snd
@ -66,18 +65,18 @@ getIndex v = do
modify $ (+1) *** (M.insert v i) modify $ (+1) *** (M.insert v i)
return i return i
makeVertexData :: ObjModel -> FaceVertex -> InterleavedObj makeVertexData :: ObjModel -> FaceVertex -> Interleaved
makeVertexData model (v, t, n) = InterleavedObj ts tt nx ny nz vx vy vz makeVertexData model (v, t, n) = Interleaved ts tt nx ny nz vx vy vz
where where
(vx, vy, vz) = genericIndex (objVertices model) v (vx, vy, vz) = genericIndex (objVertices model) v
(ts, tt) = if isJust t then genericIndex (objTexCoords model) $ fromJust t else (0, 0) (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) (nx, ny, nz) = if isJust n then genericIndex (objNormals model) $ fromJust n else (0, 0, 0)
interleaveObj :: ObjModel -> ([InterleavedObj], [[Integer]]) interleaveObj :: ObjModel -> ([Interleaved], [[Integer]])
interleaveObj model = evalState interleaveObj' (0, M.empty) interleaveObj model = evalState interleaveObj' (0, M.empty)
where where
interleaveObj' :: Interleaver ([InterleavedObj], [[Integer]]) interleaveObj' :: Interleaver ([Interleaved], [[Integer]])
interleaveObj' = do interleaveObj' = do
indices <- forM (objFaces model) $ mapM getIndex . concatMap (\(v1, v2, v3) -> [v1, v2, v3]) indices <- forM (objFaces model) $ mapM getIndex . concatMap (\(v1, v2, v3) -> [v1, v2, v3])
@ -85,7 +84,7 @@ interleaveObj model = evalState interleaveObj' (0, M.empty)
return (map (makeVertexData model) packedVertices, indices) return (map (makeVertexData model) packedVertices, indices)
makeInterleavedArrays :: ObjModel -> IO (ForeignPtr InterleavedObj, [(ForeignPtr GLuint, Int)]) makeInterleavedArrays :: ObjModel -> IO InterleavedObj
makeInterleavedArrays model = do makeInterleavedArrays model = do
let (vertexdata, indices) = interleaveObj model let (vertexdata, indices) = interleaveObj model
@ -99,8 +98,10 @@ makeInterleavedArrays model = do
return (interleavedptr, indexptrs) return (interleavedptr, indexptrs)
bindInterleavedArrays :: ForeignPtr InterleavedObj -> IO () bindInterleavedArrays :: InterleavedObj -> IO ()
bindInterleavedArrays obj = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0 bindInterleavedArrays (obj, _) = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0
drawObject :: ForeignPtr GLuint -> Int -> IO () drawObject :: InterleavedObj -> Int -> IO ()
drawObject buf l = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat drawObject (_, bufs) i = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat
where
(buf, l) = bufs!!i