From c3fdc1fa310dbfe35e3457561a1c6198954b825a Mon Sep 17 00:00:00 2001 From: 3gg <3gg@shellblade.net> Date: Wed, 4 Oct 2023 09:03:50 -0700 Subject: Allow creation of Geometry from literal arrays. Simplify Buffer. --- Spear/Render/Core/Buffer.hs | 54 +++++++----- Spear/Render/Core/Geometry.hs | 197 ++++++++++++++++++++++++++++++++++-------- Spear/Render/Core/State.hs | 65 ++++++-------- Spear/Render/Immediate.hs | 7 +- 4 files changed, 222 insertions(+), 101 deletions(-) diff --git a/Spear/Render/Core/Buffer.hs b/Spear/Render/Core/Buffer.hs index 6f1e355..a4e98a4 100644 --- a/Spear/Render/Core/Buffer.hs +++ b/Spear/Render/Core/Buffer.hs @@ -13,8 +13,8 @@ import Spear.Game import Spear.Math.Vector import Spear.Render.Core.State -import Control.Monad (void) -import Data.HashMap as HashMap +import Control.Monad (unless, void) +import qualified Data.HashMap as HashMap import Data.Word import Foreign.C.Types import Foreign.Marshal.Alloc @@ -29,6 +29,7 @@ data BufferData = BufferDataUntyped (Ptr Word8) GLuint | BufferDataVec2 [Vector2] | BufferDataVec3 [Vector3] + | BufferDataVec4 [Vector4] | BufferDataFloat [Float] | BufferDataU8 [Word8] | BufferDataU16 [Word16] @@ -36,7 +37,6 @@ data BufferData data BufferDesc = BufferDesc { bufferDescUsage :: BufferUsage - , bufferDescType :: BufferType , bufferDescData :: BufferData } @@ -52,10 +52,10 @@ makeBufferAndView desc = do } makeBuffer :: BufferDesc -> Game RenderCoreState Buffer -makeBuffer (BufferDesc usage bufferType bufferData) = do +makeBuffer (BufferDesc usage bufferData) = do handle <- gameIO $ alloca $ \ptr -> glGenBuffers 1 ptr >> peek ptr resourceKey <- register $ deleteBuffer' handle - let buffer = Buffer handle resourceKey bufferType usage + let buffer = Buffer handle resourceKey usage gameIO $ updateBuffer buffer bufferData modifyGameState (\state -> state { buffers = HashMap.insert handle buffer (buffers state) }) @@ -71,12 +71,10 @@ deleteBuffer buffer = do -- TODO: use glBufferSubData for updates. updateBuffer :: Buffer -> BufferData -> IO () updateBuffer buffer bufferData = - case bufferData of - BufferUninitialized -> return () - _ -> do - glBindBuffer GL_ARRAY_BUFFER (bufferHandle buffer) - uploadData (bufferUsage buffer) bufferData - glBindBuffer GL_ARRAY_BUFFER 0 + unless (bufferEmpty bufferData) $ do + glBindBuffer GL_ARRAY_BUFFER (bufferHandle buffer) + uploadData (bufferUsage buffer) bufferData + glBindBuffer GL_ARRAY_BUFFER 0 -- Private @@ -87,26 +85,35 @@ deleteBuffer' handle = alloca $ \ptr -> do uploadData :: BufferUsage -> BufferData -> IO () uploadData usage bufferData = case bufferData of - BufferDataUntyped ptr sizeBytes -> do + BufferDataUntyped ptr sizeBytes -> glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) (unsafeCoerce ptr) usage' - BufferDataVec2 vec2s -> withArrayLen vec2s $ \numElems ptr -> do - let sizeBytes = numElems * sizeOf (undefined :: Vector2) + BufferDataVec2 vec2s -> withArrayLen vec2s $ \numElems ptr -> glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage' - BufferDataVec3 vec3s -> withArrayLen vec3s $ \numElems ptr -> do - let sizeBytes = numElems * sizeOf (undefined :: Vector3) + BufferDataVec3 vec3s -> withArrayLen vec3s $ \numElems ptr -> glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage' - BufferDataFloat floats -> withArrayLen floats $ \numElems ptr -> do - let sizeBytes = numElems * sizeOf (undefined :: CFloat) + BufferDataVec4 vec4s -> withArrayLen vec4s $ \numElems ptr -> glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage' - BufferDataU8 ints -> withArrayLen ints $ \numElems ptr -> do - let sizeBytes = numElems * sizeOf (undefined :: Word8) + BufferDataFloat floats -> withArrayLen floats $ \numElems ptr -> glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage' - BufferDataU16 ints -> withArrayLen ints $ \numElems ptr -> do - let sizeBytes = numElems * sizeOf (undefined :: Word16) + BufferDataU8 ints -> withArrayLen ints $ \numElems ptr -> + glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage' + BufferDataU16 ints -> withArrayLen ints $ \numElems ptr -> glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage' BufferUninitialized -> return () - where usage' = toGLUsage usage + where + usage' = toGLUsage usage + sizeBytes = bufferDataSizeBytes bufferData + +bufferEmpty :: BufferData -> Bool +bufferEmpty (BufferDataUntyped ptr sizeBytes) = sizeBytes /= 0 +bufferEmpty (BufferDataVec2 list) = null list +bufferEmpty (BufferDataVec3 list) = null list +bufferEmpty (BufferDataVec4 list) = null list +bufferEmpty (BufferDataFloat list) = null list +bufferEmpty (BufferDataU8 list) = null list +bufferEmpty (BufferDataU16 list) = null list +bufferEmpty BufferUninitialized = True toGLUsage :: BufferUsage -> GLenum toGLUsage BufferStatic = GL_STATIC_DRAW @@ -117,6 +124,7 @@ bufferDataSizeBytes bufferData = case bufferData of BufferDataUntyped ptr sizeBytes -> sizeBytes BufferDataVec2 vec2s -> fromIntegral $ length vec2s * sizeOf (undefined :: Vector2) BufferDataVec3 vec3s -> fromIntegral $ length vec3s * sizeOf (undefined :: Vector3) + BufferDataVec4 vec4s -> fromIntegral $ length vec4s * sizeOf (undefined :: Vector4) BufferDataFloat floats -> fromIntegral $ length floats * 4 BufferDataU8 bytes -> fromIntegral $ length bytes BufferDataU16 words -> fromIntegral $ length words * 2 diff --git a/Spear/Render/Core/Geometry.hs b/Spear/Render/Core/Geometry.hs index aa0dfe5..6c05b38 100644 --- a/Spear/Render/Core/Geometry.hs +++ b/Spear/Render/Core/Geometry.hs @@ -1,6 +1,12 @@ module Spear.Render.Core.Geometry ( - newGeometryDesc + GeometryDesc(..) +, VertexData(..) +, Positions(..) +, Indices(..) +, Weights(..) +, GeometryUsage(..) +, newGeometryDesc , makeGeometry , deleteGeometry , renderGeometry @@ -10,19 +16,58 @@ where import Spear.Game -import Spear.Math.Vector.Vector3 +import Spear.Math.Vector import Spear.Render.Core.Buffer import Spear.Render.Core.Constants import Spear.Render.Core.State import Data.HashMap as HashMap import Data.IORef +import Data.Maybe (fromJust) +import Data.Word import Foreign.Marshal.Alloc import Foreign.Storable import Graphics.GL.Core46 import Unsafe.Coerce +data VertexData v + = FromView (BufferView v) + | FromList [v] + +data Positions + = Positions2d (VertexData Vector2) + | Positions3d (VertexData Vector3) + +data Indices + = IndicesU8 (VertexData Word8) + | IndicesU16 (VertexData Word16) + +data Weights + = WeightsU8 (VertexData Word8) + | WeightsU16 (VertexData Word16) + | WeightsFloat (VertexData Float) + +data GeometryUsage + = GeometryStatic + | GeometryDynamic + +-- | A geometry descriptor. +data GeometryDesc = GeometryDesc + { positions :: Maybe Positions -- Convenient for the empty descriptor. + , normals :: Maybe (VertexData Vector3) + , tangents :: Maybe (VertexData Vector4) + , texcoords :: Maybe (VertexData Vector4) + , joints :: Maybe Indices + , weights :: Maybe Weights + , indices :: Maybe Indices + , numVerts :: GLsizei + , numIndices :: GLsizei + , primitiveType :: PrimitiveType + , geometryUsage :: GeometryUsage + } + + newGeometryDesc :: GeometryDesc newGeometryDesc = GeometryDesc { positions = Nothing @@ -35,19 +80,21 @@ newGeometryDesc = GeometryDesc , numVerts = 0 , numIndices = 0 , primitiveType = Triangles + , geometryUsage = GeometryStatic } makeGeometry :: GeometryDesc -> Game RenderCoreState Geometry makeGeometry desc = do + gdata <- geometryDescToData desc handle <- gameIO $ alloca $ \ptr -> glGenVertexArrays 1 ptr >> peek ptr gameIO $ do glBindVertexArray handle - configureVertexAttributes desc + configureVertexAttributes gdata glBindVertexArray 0 - descRef <- gameIO $ newIORef desc + gdataRef <- gameIO $ newIORef gdata resourceKey <- register $ deleteGeometry' handle - let geometry = Geometry handle resourceKey descRef + let geometry = Geometry handle resourceKey gdataRef modifyGameState (\state -> state { geometries = HashMap.insert handle geometry (geometries state) }) return geometry @@ -60,39 +107,120 @@ deleteGeometry geometry = do renderGeometry :: Geometry -> IO () renderGeometry geometry = do - desc <- readIORef (geometryDesc geometry) - let mode = toGLPrimitiveType $ primitiveType desc + gdata <- readIORef (geometryData geometry) + let mode = toGLPrimitiveType $ geometryPrimitiveType gdata glBindVertexArray (geometryVao geometry) - case indices desc of - (Just (IndicesU8 view)) -> renderIndexed view mode (numIndices desc) GL_UNSIGNED_BYTE - (Just (IndicesU16 view)) -> renderIndexed view mode (numIndices desc) GL_UNSIGNED_SHORT - Nothing -> glDrawArrays mode 0 (numVerts desc) + case vertexIndices gdata of + (Just (VertexIndicesU8 view)) -> + renderIndexed view mode (geometryNumIndices gdata) GL_UNSIGNED_BYTE + (Just (VertexIndicesU16 view)) -> + renderIndexed view mode (geometryNumIndices gdata) GL_UNSIGNED_SHORT + Nothing -> + glDrawArrays mode 0 (geometryNumVerts gdata) glBindVertexArray 0 -- Functions for updating dynamic geometry. setPositions :: Geometry -> [Vector3] -> IO () setPositions geometry vectors = do - desc <- readIORef $ geometryDesc geometry - case positions desc of - Just (Positions3d view) -> do + gdata <- readIORef $ geometryData geometry + case vertexPositions gdata of + VertexPositions3d view -> do updateBuffer (bufferViewBuffer view) (BufferDataVec3 vectors) - updateGeometry geometry $ \desc -> desc { - numVerts = fromIntegral . length $ vectors + updateGeometry geometry $ \gdata -> gdata { + geometryNumVerts = fromIntegral . length $ vectors } _ -> putStrLn "setPositions ERROR" -- TODO: handle gracefully -- Private +geometryDescToData :: GeometryDesc -> Game RenderCoreState GeometryData +geometryDescToData desc = + let + bufferUsage = toBufferUsage (geometryUsage desc) + toBufferUsage GeometryStatic = BufferStatic + toBufferUsage GeometryDynamic = BufferDynamic + -- Maybe handling. + convert :: (a -> Game RenderCoreState b) -> Maybe a -> Game RenderCoreState (Maybe b) + convert f value = case value of + Nothing -> return Nothing + Just x -> Just <$> f x + -- 2d vectors + convert2d :: VertexData Vector2 -> Game RenderCoreState (BufferView Vector2) + convert2d (FromView view) = return view + convert2d (FromList vec2s) = makeBufferAndView $ + BufferDesc bufferUsage (BufferDataVec2 vec2s) + -- 3d vectors + convert3d :: VertexData Vector3 -> Game RenderCoreState (BufferView Vector3) + convert3d (FromView view) = return view + convert3d (FromList vec3s) = makeBufferAndView $ + BufferDesc bufferUsage (BufferDataVec3 vec3s) + -- 4d vectors + convert4d :: VertexData Vector4 -> Game RenderCoreState (BufferView Vector4) + convert4d (FromView view) = return view + convert4d (FromList vec4s) = makeBufferAndView $ + BufferDesc bufferUsage (BufferDataVec4 vec4s) + -- U8 + convertU8 :: VertexData Word8 -> Game RenderCoreState (BufferView Word8) + convertU8 (FromView view) = return view + convertU8 (FromList list) = makeBufferAndView + (BufferDesc BufferStatic (BufferDataU8 $ fromIntegral <$> list)) + -- U16 + convertU16 :: VertexData Word16 -> Game RenderCoreState (BufferView Word16) + convertU16 (FromView view) = return view + convertU16 (FromList list) = makeBufferAndView + (BufferDesc BufferStatic (BufferDataU16 $ fromIntegral <$> list)) + -- Floats + convertFloat :: VertexData Float -> Game RenderCoreState (BufferView Float) + convertFloat (FromView view) = return view + convertFloat (FromList list) = makeBufferAndView + (BufferDesc BufferStatic (BufferDataFloat list)) + -- Positions + convertPositions :: Positions -> Game RenderCoreState VertexPositions + convertPositions (Positions2d positions) = VertexPositions2d <$> convert2d positions + convertPositions (Positions3d positions) = VertexPositions3d <$> convert3d positions + -- Joints + convertJoints :: Indices -> Game RenderCoreState VertexJoints + convertJoints (IndicesU8 joints) = VertexJointsU8 <$> convertU8 joints + convertJoints (IndicesU16 joints) = VertexJointsU16 <$> convertU16 joints + -- Weights + convertWeights :: Weights -> Game RenderCoreState VertexWeights + convertWeights (WeightsU8 weights) = VertexWeightsU8 <$> convertU8 weights + convertWeights (WeightsU16 weights) = VertexWeightsU16 <$> convertU16 weights + convertWeights (WeightsFloat weights) = VertexWeightsFloat <$> convertFloat weights + -- Indices + convertIndices :: Indices -> Game RenderCoreState VertexIndices + convertIndices (IndicesU8 indices) = VertexIndicesU8 <$> convertU8 indices + convertIndices (IndicesU16 indices) = VertexIndicesU16 <$> convertU16 indices + in do + vertexPositions <- convertPositions (fromJust $ positions desc) + vertexNormals <- convert convert3d (normals desc) + vertexTangents <- convert convert4d (tangents desc) + vertexTexcoords <- convert convert4d (texcoords desc) + vertexJoints <- convert convertJoints (joints desc) + vertexWeights <- convert convertWeights (weights desc) + vertexIndices <- convert convertIndices (indices desc) + return $ GeometryData + vertexPositions + vertexNormals + vertexTangents + vertexTexcoords + vertexJoints + vertexWeights + vertexIndices + (numVerts desc) + (numIndices desc) + (primitiveType desc) + deleteGeometry' :: GLenum -> IO () deleteGeometry' handle = alloca $ \ptr -> do poke ptr handle glDeleteVertexArrays 1 ptr -updateGeometry :: Geometry -> (GeometryDesc -> GeometryDesc) -> IO () +updateGeometry :: Geometry -> (GeometryData -> GeometryData) -> IO () updateGeometry geometry update = do - desc <- readIORef $ geometryDesc geometry - writeIORef (geometryDesc geometry) (update desc) + gdata <- readIORef $ geometryData geometry + writeIORef (geometryData geometry) (update gdata) renderIndexed :: BufferView a -> GLenum -> GLsizei -> GLenum -> IO () renderIndexed view mode numIndices indexElemSize = do @@ -100,29 +228,28 @@ renderIndexed view mode numIndices indexElemSize = do glDrawElements mode numIndices GL_UNSIGNED_SHORT (unsafeCoerce $ bufferViewOffsetBytes view) glBindBuffer GL_ELEMENT_ARRAY_BUFFER 0 -configureVertexAttributes :: GeometryDesc -> IO () -configureVertexAttributes desc = do - case positions desc of - Just (Positions2d view) -> configureView view positionChannel 2 GL_FLOAT GL_FALSE - Just (Positions3d view) -> configureView view positionChannel 3 GL_FLOAT GL_FALSE - Nothing -> return () - case normals desc of +configureVertexAttributes :: GeometryData -> IO () +configureVertexAttributes gdata = do + case vertexPositions gdata of + VertexPositions2d view -> configureView view positionChannel 2 GL_FLOAT GL_FALSE + VertexPositions3d view -> configureView view positionChannel 3 GL_FLOAT GL_FALSE + case vertexNormals gdata of Just view -> configureView view normalChannel 3 GL_FLOAT GL_FALSE Nothing -> return () - case tangents desc of + case vertexTangents gdata of Just view -> configureView view tangentChannel 4 GL_FLOAT GL_FALSE Nothing -> return () - case texcoords desc of + case vertexTexcoords gdata of Just view -> configureView view texcoordsChannel 2 GL_FLOAT GL_FALSE Nothing -> return () - case joints desc of - Just (JointsU8 view) -> configureView view jointsChannel 4 GL_UNSIGNED_BYTE GL_FALSE - Just (JointsU16 view) -> configureView view jointsChannel 4 GL_UNSIGNED_SHORT GL_FALSE + case vertexJoints gdata of + Just (VertexJointsU8 view) -> configureView view jointsChannel 4 GL_UNSIGNED_BYTE GL_FALSE + Just (VertexJointsU16 view) -> configureView view jointsChannel 4 GL_UNSIGNED_SHORT GL_FALSE Nothing -> return () - case weights desc of - Just (WeightsU8 view) -> configureView view weightsChannel 4 GL_UNSIGNED_BYTE GL_TRUE - Just (WeightsU16 view) -> configureView view weightsChannel 4 GL_UNSIGNED_SHORT GL_TRUE - Just (WeightsFloat view) -> configureView view weightsChannel 4 GL_FLOAT GL_FALSE + case vertexWeights gdata of + Just (VertexWeightsU8 view) -> configureView view weightsChannel 4 GL_UNSIGNED_BYTE GL_TRUE + Just (VertexWeightsU16 view) -> configureView view weightsChannel 4 GL_UNSIGNED_SHORT GL_TRUE + Just (VertexWeightsFloat view) -> configureView view weightsChannel 4 GL_FLOAT GL_FALSE Nothing -> return () -- TODO: Add the assertion: diff --git a/Spear/Render/Core/State.hs b/Spear/Render/Core/State.hs index 34b0732..f7e5627 100644 --- a/Spear/Render/Core/State.hs +++ b/Spear/Render/Core/State.hs @@ -11,15 +11,6 @@ import Graphics.GL.Core46 -data BufferType - = BufferUntyped - | Buffer2d - | Buffer3d - | Buffer4d - | BufferFloat - | BufferU8 - | BufferU16 - data BufferUsage = BufferStatic | BufferDynamic @@ -28,7 +19,6 @@ data BufferUsage data Buffer = Buffer { bufferHandle :: GLuint , bufferResource :: Resource - , bufferType :: BufferType , bufferUsage :: BufferUsage } @@ -41,50 +31,49 @@ data BufferView a = BufferView } -data Positions - = Positions2d (BufferView Vector2) - | Positions3d (BufferView Vector3) +data VertexPositions + = VertexPositions2d (BufferView Vector2) + | VertexPositions3d (BufferView Vector3) -data Joints - = JointsU8 (BufferView Word8) - | JointsU16 (BufferView Word16) +data VertexJoints + = VertexJointsU8 (BufferView Word8) + | VertexJointsU16 (BufferView Word16) -data Weights - = WeightsU8 (BufferView Word8) - | WeightsU16 (BufferView Word16) - | WeightsFloat (BufferView Float) +data VertexWeights + = VertexWeightsU8 (BufferView Word8) + | VertexWeightsU16 (BufferView Word16) + | VertexWeightsFloat (BufferView Float) -data Indices - = IndicesU8 (BufferView Word8) - | IndicesU16 (BufferView Word16) +data VertexIndices + = VertexIndicesU8 (BufferView Word8) + | VertexIndicesU16 (BufferView Word16) data PrimitiveType = Triangles | TriangleFan | TriangleStrip --- | A geometry descriptor. -data GeometryDesc = GeometryDesc - { positions :: Maybe Positions -- Convenient for the empty descriptor. - , normals :: Maybe (BufferView Vector3) - , tangents :: Maybe (BufferView Vector4) - , texcoords :: Maybe (BufferView Vector4) - , joints :: Maybe Joints - , weights :: Maybe Weights - , indices :: Maybe Indices - , numVerts :: GLsizei - , numIndices :: GLsizei - , primitiveType :: PrimitiveType +data GeometryData = GeometryData + { vertexPositions :: VertexPositions + , vertexNormals :: Maybe (BufferView Vector3) + , vertexTangents :: Maybe (BufferView Vector4) + , vertexTexcoords :: Maybe (BufferView Vector4) + , vertexJoints :: Maybe VertexJoints + , vertexWeights :: Maybe VertexWeights + , vertexIndices :: Maybe VertexIndices + , geometryNumVerts :: GLsizei + , geometryNumIndices :: GLsizei + , geometryPrimitiveType :: PrimitiveType } -- | A piece of renderable geometry. -- --- Since dynamic geometry can be mutated, the descriptor is stored as an IORef --- so that its state cannot become stale after an update. +-- Since dynamic geometry can be mutated, the data is stored as an IORef so that +-- its state cannot become stale after an update. data Geometry = Geometry { geometryVao :: GLuint , geometryResource :: Resource - , geometryDesc :: IORef GeometryDesc + , geometryData :: IORef GeometryData } diff --git a/Spear/Render/Immediate.hs b/Spear/Render/Immediate.hs index ca5d5c5..44fe7a6 100644 --- a/Spear/Render/Immediate.hs +++ b/Spear/Render/Immediate.hs @@ -54,13 +54,10 @@ newImmRenderer = do (ShaderFromFile "/home/jeanne/src/gfx/gfx/shaders/immediate_mode.frag") [] shader <- compileShaderProgram [vs, ps] - -- TODO: Make 'makeGeometry' easier to use. GeometryDesc should be able to - -- take (possibly empty) lists as inputs. - positions <- makeBufferAndView $ - BufferDesc BufferDynamic Buffer3d BufferUninitialized triangles <- makeGeometry $ newGeometryDesc - { positions = Just (Positions3d positions) + { positions = Just (Positions3d (FromList [])) , primitiveType = Triangles + , geometryUsage = GeometryDynamic } return ImmRenderState -- cgit v1.2.3