From 67bcdd1e3acfb40ec3fde31740416ed1ebf755db Mon Sep 17 00:00:00 2001 From: Jeanne-Kamikaze Date: Tue, 12 Mar 2013 15:51:27 +0100 Subject: Made uniforms and bufferData prettier --- Spear/GL.hs | 164 +++++++++++++++++++++++------------------- Spear/Render/AnimatedModel.hs | 20 +++--- Spear/Render/StaticModel.hs | 18 ++--- 3 files changed, 108 insertions(+), 94 deletions(-) diff --git a/Spear/GL.hs b/Spear/GL.hs index d3a42f0..65f985b 100644 --- a/Spear/GL.hs +++ b/Spear/GL.hs @@ -1,24 +1,11 @@ module Spear.GL ( - -- * General Management - GLSLShader -, GLSLProgram -, ShaderType(..) - -- ** Programs + -- * Programs + GLSLProgram , newProgram , linkProgram , useProgram , withGLSLProgram - -- ** Shaders -, attachShader -, detachShader -, loadShader -, newShader - -- *** Source loading -, loadSource -, shaderSource -, readSource -, compile -- ** Locations , attribLocation , fragLocation @@ -29,16 +16,25 @@ module Spear.GL , uniformVec4 , uniformMat3 , uniformMat4 -, uniformfl -, uniformil - -- ** Helper functions +, LoadUniforms(..) + -- * Shaders +, GLSLShader +, ShaderType(..) +, attachShader +, detachShader +, loadShader +, newShader + -- ** Source loading +, loadSource +, shaderSource +, readSource +, compile + -- * Helper functions , ($=) , Data.StateVar.get -- * VAOs , VAO - -- ** Creation and destruction , newVAO - -- ** Manipulation , bindVAO , enableVAOAttrib , attribVAOPointer @@ -49,12 +45,10 @@ module Spear.GL , GLBuffer , TargetBuffer(..) , BufferUsage(..) - -- ** Creation and destruction , newBuffer - -- ** Manipulation , bindBuffer -, bufferData -, bufferDatal +, BufferData(..) +, bufferData' , withGLBuffer -- * Textures , Texture @@ -92,7 +86,9 @@ import Control.Monad.Trans.Error import Control.Monad.Trans.State as State import qualified Data.ByteString.Char8 as B import Data.StateVar +import Data.Word import Foreign.C.String +import Foreign.C.Types import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Utils as Foreign (with) @@ -140,9 +136,8 @@ withGLSLProgram prog f = f $ getProgram prog -- | Get the location of the given uniform variable within the given program. uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint -uniformLocation prog var = makeGettableStateVar get - where - get = withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str) +uniformLocation prog var = makeGettableStateVar $ + withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str) -- | Get or set the location of the given variable to a fragment shader colour number. fragLocation :: GLSLProgram -> String -> StateVar GLint @@ -167,10 +162,10 @@ newProgram shaders = do when (h == 0) $ gameError "glCreateProgram failed" rkey <- register $ deleteProgram h let program = GLSLProgram h rkey - + mapM_ (gameIO . attachShader program) shaders linkProgram program - + return program -- | Delete the program. @@ -192,7 +187,7 @@ linkProgram prog = do case status of 0 -> getStatus glGetProgramiv glGetProgramInfoLog h _ -> return "" - + case length err of 0 -> return () _ -> gameError err @@ -258,10 +253,10 @@ shaderSource shader str = compile :: FilePath -> GLSLShader -> Game s () compile file shader = do let h = getShader shader - + -- Compile gameIO $ glCompileShader h - + -- Verify status err <- gameIO $ alloca $ \statusPtr -> do glGetShaderiv h gl_COMPILE_STATUS statusPtr @@ -269,11 +264,11 @@ compile file shader = do case result of 0 -> getStatus glGetShaderiv glGetShaderInfoLog h _ -> return "" - + case length err of 0 -> return () _ -> gameError $ "Unable to compile shader " ++ file ++ ":\n" ++ err - + type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO () type LogCall = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO () @@ -314,16 +309,16 @@ readSource' file = do if isInclude l then readSource' $ B.unpack . clean . cleanInclude $ l else return l - + contents <- B.readFile file - + dir <- getCurrentDirectory let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file - + setCurrentDirectory dir' code <- parse contents setCurrentDirectory dir - + return code -- | Load a 2D vector. @@ -338,7 +333,7 @@ uniformVec3 loc v = glUniform3f loc x' y' z' where x' = unsafeCoerce $ x v y' = unsafeCoerce $ y v z' = unsafeCoerce $ z v - + -- | Load a 4D vector. uniformVec4 :: GLint -> Vector4 -> IO () uniformVec4 loc v = glUniform4f loc x' y' z' w' @@ -359,23 +354,25 @@ uniformMat4 loc mat = with mat $ \ptrMat -> glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) --- | Load a list of floats. -uniformfl :: GLint -> [GLfloat] -> IO () -uniformfl loc vals = withArray vals $ \ptr -> - case length vals of - 1 -> glUniform1fv loc 1 ptr - 2 -> glUniform2fv loc 1 ptr - 3 -> glUniform3fv loc 1 ptr - 4 -> glUniform4fv loc 1 ptr - --- | Load a list of integers. -uniformil :: GLint -> [GLint] -> IO () -uniformil loc vals = withArray vals $ \ptr -> - case length vals of - 1 -> glUniform1iv loc 1 ptr - 2 -> glUniform2iv loc 1 ptr - 3 -> glUniform3iv loc 1 ptr - 4 -> glUniform4iv loc 1 ptr +class LoadUniforms a where + -- | Load a list of uniform values. + uniforml :: GLint -> [a] -> IO () + +instance LoadUniforms Float where + uniforml loc vals = withArray (map unsafeCoerce vals) $ \ptr -> + case length vals of + 1 -> glUniform1fv loc 1 ptr + 2 -> glUniform2fv loc 1 ptr + 3 -> glUniform3fv loc 1 ptr + 4 -> glUniform4fv loc 1 ptr + +instance LoadUniforms Int where + uniforml loc vals = withArray (map fromIntegral vals) $ \ptr -> + case length vals of + 1 -> glUniform1iv loc 1 ptr + 2 -> glUniform2iv loc 1 ptr + 3 -> glUniform3iv loc 1 ptr + 4 -> glUniform4iv loc 1 ptr -- -- VAOs @@ -402,7 +399,7 @@ newVAO = do h <- gameIO . alloca $ \ptr -> do glGenVertexArrays 1 ptr peek ptr - + rkey <- register $ deleteVAO h return $ VAO h rkey @@ -415,7 +412,7 @@ bindVAO :: VAO -> IO () bindVAO = glBindVertexArray . getVAO -- | Enable the given vertex attribute of the bound vao. --- +-- -- See also 'bindVAO'. enableVAOAttrib :: GLuint -- ^ Attribute index. -> IO () @@ -445,7 +442,7 @@ drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoer drawElements :: GLenum -- ^ The kind of primitives to render. -> Int -- ^ The number of elements to be rendered. - -> GLenum -- ^ The type of the index values. Must be one of gl_UNSIGNED_BYTE, gl_UNSIGNED_SHORT, or gl_UNSIGNED_INT. + -> GLenum -- ^ The type of the index values. Must be one of gl_UNSIGNED_BYTE, gl_UNSIGNED_SHORT, or gl_UNSIGNED_INT. -> Ptr a -- ^ Pointer to the location where indices are stored, or offset into the index array when there is a bound ElementArrayBuffer. -> IO () drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs @@ -470,7 +467,7 @@ data TargetBuffer | PixelPackBuffer | PixelUnpackBuffer deriving (Eq, Show) - + fromTarget :: TargetBuffer -> GLenum fromTarget ArrayBuffer = gl_ARRAY_BUFFER fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER @@ -507,7 +504,7 @@ newBuffer = do h <- gameIO . alloca $ \ptr -> do glGenBuffers 1 ptr peek ptr - + rkey <- register $ deleteBuffer h return $ GLBuffer h rkey @@ -519,23 +516,40 @@ deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1 bindBuffer :: GLBuffer -> TargetBuffer -> IO () bindBuffer buf target = glBindBuffer (fromTarget target) $ getBuffer buf --- | Set the buffer's data. -bufferData :: TargetBuffer - -> Int -- ^ Buffer size in bytes. - -> Ptr a +class Storable a => BufferData a where + -- | Set the buffer's data. + bufferData :: TargetBuffer -> [a] -> BufferUsage -> IO () + bufferData tgt vals usage = + let n = sizeOf (undefined :: Word8) * length vals + in withArray vals $ \ptr -> bufferData' tgt n ptr usage + +instance BufferData Word8 +instance BufferData Word16 +instance BufferData Word32 +instance BufferData CChar +instance BufferData CInt +instance BufferData CFloat +instance BufferData CDouble +instance BufferData Int +instance BufferData Float +instance BufferData Double + +{-bufferData :: Storable a + => TargetBuffer + -> Int -- ^ The size in bytes of an element in the data list. + -> [a] -- ^ The data list. -> BufferUsage -> IO () -bufferData target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage) +bufferData target n bufData usage = withArray bufData $ + \ptr -> bufferData target (n * length bufData) ptr usage-} -- | Set the buffer's data. -bufferDatal :: Storable a - => TargetBuffer - -> Int -- ^ The size in bytes of an element in the data list. - -> [a] -- ^ The data list. +bufferData' :: TargetBuffer + -> Int -- ^ Buffer size in bytes. + -> Ptr a -> BufferUsage -> IO () -bufferDatal target n bufData usage = withArray bufData $ - \ptr -> bufferData target (n * length bufData) ptr usage +bufferData' target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage) -- | Apply the given function the buffer's id. withGLBuffer :: GLBuffer -> (GLuint -> a) -> a @@ -566,7 +580,7 @@ newTexture = do tex <- gameIO . alloca $ \ptr -> do glGenTextures 1 ptr peek ptr - + rkey <- register $ deleteTexture tex return $ Texture tex rkey @@ -590,12 +604,12 @@ loadTextureImage file minFilter magFilter = do h = height image pix = pixels image rgb = fromIntegral . fromEnum $ gl_RGB - + bindTexture tex loadTextureData gl_TEXTURE_2D 0 rgb w h 0 gl_RGB gl_UNSIGNED_BYTE pix texParami gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER $= minFilter texParami gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER $= magFilter - + return tex -- | Bind the texture. diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs index 9c05109..aa202ec 100644 --- a/Spear/Render/AnimatedModel.hs +++ b/Spear/Render/AnimatedModel.hs @@ -107,35 +107,35 @@ animatedModelResource elementBuf <- newBuffer vao <- newVAO boxes <- gameIO $ modelBoxes model - + gameIO $ do - + let elemSize = 56 elemSize' = fromIntegral elemSize - n = numVertices * numFrames - + n = numVertices * numFrames + bindVAO vao - + bindBuffer elementBuf ArrayBuffer - bufferData ArrayBuffer (unsafeCoerce $ elemSize * n) elements StaticDraw - + bufferData' ArrayBuffer (unsafeCoerce $ elemSize * n) elements StaticDraw + attribVAOPointer vertChan1 3 gl_FLOAT False elemSize' 0 attribVAOPointer vertChan2 3 gl_FLOAT False elemSize' 12 attribVAOPointer normChan1 3 gl_FLOAT False elemSize' 24 attribVAOPointer normChan2 3 gl_FLOAT False elemSize' 36 attribVAOPointer texChan 2 gl_FLOAT False elemSize' 48 - + enableVAOAttrib vertChan1 enableVAOAttrib vertChan2 enableVAOAttrib normChan1 enableVAOAttrib normChan2 enableVAOAttrib texChan - + rkey <- register $ do putStrLn "Releasing animated model resource" clean vao clean elementBuf - + return $ AnimatedModelResource model vao (unsafeCoerce numFrames) (unsafeCoerce numVertices) material texture boxes rkey diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs index cadf350..700414f 100644 --- a/Spear/Render/StaticModel.hs +++ b/Spear/Render/StaticModel.hs @@ -69,31 +69,31 @@ staticModelResource (StaticProgramChannels vertChan normChan texChan) material t elementBuf <- newBuffer vao <- newVAO boxes <- gameIO $ modelBoxes model - + gameIO $ do - + let elemSize = 32 elemSize' = fromIntegral elemSize n = numVertices - + bindVAO vao - + bindBuffer elementBuf ArrayBuffer - bufferData ArrayBuffer (fromIntegral $ elemSize*n) elements StaticDraw - + bufferData' ArrayBuffer (fromIntegral $ elemSize*n) elements StaticDraw + attribVAOPointer vertChan 3 gl_FLOAT False elemSize' 0 attribVAOPointer normChan 3 gl_FLOAT False elemSize' 12 attribVAOPointer texChan 2 gl_FLOAT False elemSize' 24 - + enableVAOAttrib vertChan enableVAOAttrib normChan enableVAOAttrib texChan - + rkey <- register $ do putStrLn "Releasing static model resource" clean vao clean elementBuf - + return $ StaticModelResource vao (unsafeCoerce numVertices) material texture boxes rkey -- cgit v1.2.3