From c8a67b6a5fe90e1ec3395ae61e5bcfce5cdf4d33 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Fri, 16 Apr 2010 09:09:58 +0200 Subject: Renamed obj-model-gl to obj-model-opengl --- src/Data/Obj3D/GL.hs | 107 ----------------------------------------------- src/Data/Obj3D/OpenGL.hs | 107 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+), 107 deletions(-) delete mode 100644 src/Data/Obj3D/GL.hs create mode 100644 src/Data/Obj3D/OpenGL.hs (limited to 'src/Data/Obj3D') diff --git a/src/Data/Obj3D/GL.hs b/src/Data/Obj3D/GL.hs deleted file mode 100644 index 30169b4..0000000 --- a/src/Data/Obj3D/GL.hs +++ /dev/null @@ -1,107 +0,0 @@ -module Data.Obj3D.GL ( Interleaved - , InterleavedObj - , interleavedArrayFormat - , indexArrayFormat - , interleaveObj - , makeInterleavedArrays - , bindInterleavedArrays - , drawObject - ) 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 Interleaved = Interleaved - { texCoordS :: GLfloat - , texCoordT :: GLfloat - , normalX :: GLfloat - , normalY :: GLfloat - , normalZ :: GLfloat - , vertexX :: GLfloat - , vertexY :: GLfloat - , vertexZ :: GLfloat - } deriving Show - -instance Storable Interleaved where - sizeOf _ = 8 * sizeOf (undefined :: GLfloat) - alignment _ = alignment (undefined :: GLfloat) - - 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 - -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 -> Interleaved -makeVertexData model (v, t, n) = Interleaved tu (-tv) nx ny nz vx vy vz - where - (vx, vy, vz) = genericIndex (objVertices model) v - (tu, tv) = 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 -> ([Interleaved], [[Integer]]) -interleaveObj model = evalState interleaveObj' (0, M.empty) - where - interleaveObj' :: Interleaver ([Interleaved], [[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 InterleavedObj -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 :: InterleavedObj -> IO () -bindInterleavedArrays (obj, _) = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0 - -drawObject :: InterleavedObj -> Int -> IO () -drawObject (_, bufs) i = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat - where - (buf, l) = bufs!!i diff --git a/src/Data/Obj3D/OpenGL.hs b/src/Data/Obj3D/OpenGL.hs new file mode 100644 index 0000000..0e9b5c5 --- /dev/null +++ b/src/Data/Obj3D/OpenGL.hs @@ -0,0 +1,107 @@ +module Data.Obj3D.OpenGL ( Interleaved + , InterleavedObj + , interleavedArrayFormat + , indexArrayFormat + , interleaveObj + , makeInterleavedArrays + , bindInterleavedArrays + , drawObject + ) 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 Interleaved = Interleaved + { texCoordS :: GLfloat + , texCoordT :: GLfloat + , normalX :: GLfloat + , normalY :: GLfloat + , normalZ :: GLfloat + , vertexX :: GLfloat + , vertexY :: GLfloat + , vertexZ :: GLfloat + } deriving Show + +instance Storable Interleaved where + sizeOf _ = 8 * sizeOf (undefined :: GLfloat) + alignment _ = alignment (undefined :: GLfloat) + + 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 + +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 -> Interleaved +makeVertexData model (v, t, n) = Interleaved tu (-tv) nx ny nz vx vy vz + where + (vx, vy, vz) = genericIndex (objVertices model) v + (tu, tv) = 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 -> ([Interleaved], [[Integer]]) +interleaveObj model = evalState interleaveObj' (0, M.empty) + where + interleaveObj' :: Interleaver ([Interleaved], [[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 InterleavedObj +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 :: InterleavedObj -> IO () +bindInterleavedArrays (obj, _) = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0 + +drawObject :: InterleavedObj -> Int -> IO () +drawObject (_, bufs) i = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat + where + (buf, l) = bufs!!i -- cgit v1.2.3