summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Obj3D/GL.hs39
1 files changed, 20 insertions, 19 deletions
diff --git a/src/Data/Obj3D/GL.hs b/src/Data/Obj3D/GL.hs
index fb089ba..1cfa5c6 100644
--- a/src/Data/Obj3D/GL.hs
+++ b/src/Data/Obj3D/GL.hs
@@ -1,12 +1,11 @@
-module Data.Obj3D.GL ( InterleavedObj
+module Data.Obj3D.GL ( Interleaved
+ , InterleavedObj
, interleavedArrayFormat
, indexArrayFormat
, interleaveObj
, makeInterleavedArrays
, bindInterleavedArrays
, drawObject
- , GLuint
- , ForeignPtr
) where
import Data.Obj3D
@@ -27,7 +26,7 @@ import Foreign.Storable
import qualified Data.Map as M
-data InterleavedObj = InterleavedObj
+data Interleaved = Interleaved
{ texCoordS :: GLfloat
, texCoordT :: GLfloat
, normalX :: GLfloat
@@ -38,24 +37,24 @@ data InterleavedObj = InterleavedObj
, vertexZ :: GLfloat
} deriving Show
-instance Storable InterleavedObj where
+instance Storable Interleaved where
sizeOf _ = 8 * sizeOf (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]
+type InterleavedObj = (ForeignPtr Interleaved, [(ForeignPtr GLuint, Int)])
+
+type Interleaver a = State (Integer, M.Map FaceVertex Integer) a
+
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
@@ -66,18 +65,18 @@ getIndex v = do
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
+makeVertexData :: ObjModel -> FaceVertex -> Interleaved
+makeVertexData model (v, t, n) = Interleaved 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 :: ObjModel -> ([Interleaved], [[Integer]])
interleaveObj model = evalState interleaveObj' (0, M.empty)
where
- interleaveObj' :: Interleaver ([InterleavedObj], [[Integer]])
+ interleaveObj' :: Interleaver ([Interleaved], [[Integer]])
interleaveObj' = do
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)
-makeInterleavedArrays :: ObjModel -> IO (ForeignPtr InterleavedObj, [(ForeignPtr GLuint, Int)])
+makeInterleavedArrays :: ObjModel -> IO InterleavedObj
makeInterleavedArrays model = do
let (vertexdata, indices) = interleaveObj model
@@ -99,8 +98,10 @@ makeInterleavedArrays model = do
return (interleavedptr, indexptrs)
-bindInterleavedArrays :: ForeignPtr InterleavedObj -> IO ()
-bindInterleavedArrays obj = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0
+bindInterleavedArrays :: InterleavedObj -> IO ()
+bindInterleavedArrays (obj, _) = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0
-drawObject :: ForeignPtr GLuint -> Int -> IO ()
-drawObject buf l = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat
+drawObject :: InterleavedObj -> Int -> IO ()
+drawObject (_, bufs) i = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat
+ where
+ (buf, l) = bufs!!i