diff options
Diffstat (limited to 'src/Data/Obj3D')
| -rw-r--r-- | src/Data/Obj3D/GL.hs | 39 |
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 |