summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Obj3D/GL.hs106
1 files changed, 106 insertions, 0 deletions
diff --git a/src/Data/Obj3D/GL.hs b/src/Data/Obj3D/GL.hs
new file mode 100644
index 0000000..fb089ba
--- /dev/null
+++ b/src/Data/Obj3D/GL.hs
@@ -0,0 +1,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