From 1f4b8ec3b58e329f27432a3fbc9ab37f3da84899 Mon Sep 17 00:00:00 2001 From: Jeanne-Kamikaze Date: Fri, 22 Feb 2013 15:19:59 +0100 Subject: GLSL -> GL --- Spear.cabal | 2 +- Spear/GL.hs | 672 ++++++++++++++++++++++++++++++++++++++++++ Spear/GLSL.hs | 672 ------------------------------------------ Spear/Render/AnimatedModel.hs | 2 +- Spear/Render/Program.hs | 17 +- Spear/Render/StaticModel.hs | 2 +- Spear/Scene/GameObject.hs | 2 +- Spear/Scene/Loader.hs | 24 +- Spear/Scene/SceneResources.hs | 12 +- 9 files changed, 690 insertions(+), 715 deletions(-) create mode 100644 Spear/GL.hs delete mode 100644 Spear/GLSL.hs diff --git a/Spear.cabal b/Spear.cabal index 2f21fad..316c1eb 100644 --- a/Spear.cabal +++ b/Spear.cabal @@ -20,7 +20,7 @@ library Spear.Physics.Types Spear.App Spear.App.Application Spear.App.Input Spear.Assets.Image Spear.Assets.Model Spear.Collision Spear.Math.AABB Spear.Math.Circle Spear.Math.Triangle Spear.Game - Spear.GLSL Spear.Math.Camera Spear.Math.Entity Spear.Math.Matrix3 + Spear.GL Spear.Math.Camera Spear.Math.Entity Spear.Math.Matrix3 Spear.Math.Matrix4 Spear.Math.MatrixUtils Spear.Math.Plane Spear.Math.Quaternion Spear.Math.Vector Spear.Math.Vector.Class Spear.Math.Vector.Vector3 Spear.Math.Vector.Vector4 diff --git a/Spear/GL.hs b/Spear/GL.hs new file mode 100644 index 0000000..05e439a --- /dev/null +++ b/Spear/GL.hs @@ -0,0 +1,672 @@ +module Spear.GL +( + -- * General Management + GLSLShader +, GLSLProgram +, ShaderType(..) + -- ** Programs +, newProgram +, linkProgram +, useProgram +, withGLSLProgram + -- ** Shaders +, attachShader +, detachShader +, loadShader +, newShader + -- *** Source loading +, loadSource +, shaderSource +, readSource +, compile + -- ** Locations +, attribLocation +, fragLocation +, uniformLocation + -- ** Uniforms +, uniformVec2 +, uniformVec3 +, uniformVec4 +, uniformMat3 +, uniformMat4 +, uniformfl +, uniformil + -- ** Helper functions +, ($=) +, Data.StateVar.get + -- * VAOs +, VAO + -- ** Creation and destruction +, newVAO + -- ** Manipulation +, bindVAO +, enableVAOAttrib +, attribVAOPointer + -- ** Rendering +, drawArrays +, drawElements + -- * Buffers +, GLBuffer +, TargetBuffer(..) +, BufferUsage(..) + -- ** Creation and destruction +, newBuffer + -- ** Manipulation +, bindBuffer +, bufferData +, bufferDatal +, withGLBuffer + -- * Textures +, Texture +, SettableStateVar +, ($) + -- ** Creation and destruction +, newTexture +, loadTextureImage + -- ** Manipulation +, bindTexture +, loadTextureData +, texParami +, texParamf +, activeTexture + -- * Error Handling +, getGLError +, printGLError +, assertGL + -- * OpenGL +, module Graphics.Rendering.OpenGL.Raw.Core31 +, Ptr +, nullPtr +) +where + +import Spear.Assets.Image +import Spear.Game +import Spear.Math.Matrix3 (Matrix3) +import Spear.Math.Matrix4 (Matrix4) +import Spear.Math.Vector + +import Control.Monad +import Control.Monad.Trans.Class +import Control.Monad.Trans.Error +import Control.Monad.Trans.State as State +import qualified Data.ByteString.Char8 as B +import Data.StateVar +import Foreign.C.String +import Foreign.Ptr +import Foreign.Storable +import Foreign.Marshal.Utils as Foreign (with) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Array (withArray) +import Foreign.Storable (peek) +import Graphics.Rendering.OpenGL.Raw.Core31 +import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory) +import System.IO (hPutStrLn, stderr) +import Unsafe.Coerce + +-- +-- MANAGEMENT +-- + +-- | A GLSL shader handle. +data GLSLShader = GLSLShader + { getShader :: GLuint + , getShaderKey :: Resource + } + +instance ResourceClass GLSLShader where + getResource = getShaderKey + +-- | A GLSL program handle. +data GLSLProgram = GLSLProgram + { getProgram :: GLuint + , getProgramKey :: Resource + } + +instance ResourceClass GLSLProgram where + getResource = getProgramKey + +-- | Supported shader types. +data ShaderType = VertexShader | FragmentShader deriving (Eq, Show) + +toGLShader :: ShaderType -> GLenum +toGLShader VertexShader = gl_VERTEX_SHADER +toGLShader FragmentShader = gl_FRAGMENT_SHADER + +-- | Apply the given function to the program's id. +withGLSLProgram :: GLSLProgram -> (GLuint -> a) -> a +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) + +-- | Get or set the location of the given variable to a fragment shader colour number. +fragLocation :: GLSLProgram -> String -> StateVar GLint +fragLocation prog var = makeStateVar get set + where + get = withCString var $ \str -> glGetFragDataLocation (getProgram prog) (unsafeCoerce str) + set idx = withCString var $ \str -> + glBindFragDataLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str) + +-- | Get or set the location of the given attribute within the given program. +attribLocation :: GLSLProgram -> String -> StateVar GLint +attribLocation prog var = makeStateVar get set + where + get = withCString var $ \str -> glGetAttribLocation (getProgram prog) (unsafeCoerce str) + set idx = withCString var $ \str -> + glBindAttribLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str) + +-- | Create a new program. +newProgram :: [GLSLShader] -> Game s GLSLProgram +newProgram shaders = do + h <- gameIO glCreateProgram + 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. +deleteProgram :: GLuint -> IO () +--deleteProgram = glDeleteProgram +deleteProgram prog = do + putStrLn $ "Deleting shader program " ++ show prog + glDeleteProgram prog + +-- | Link the program. +linkProgram :: GLSLProgram -> Game s () +linkProgram prog = do + let h = getProgram prog + err <- gameIO $ do + glLinkProgram h + alloca $ \statptr -> do + glGetProgramiv h gl_LINK_STATUS statptr + status <- peek statptr + case status of + 0 -> getStatus glGetProgramiv glGetProgramInfoLog h + _ -> return "" + + case length err of + 0 -> return () + _ -> gameError err + +-- | Use the program. +useProgram :: GLSLProgram -> IO () +useProgram prog = glUseProgram $ getProgram prog + +-- | Attach the given shader to the given program. +attachShader :: GLSLProgram -> GLSLShader -> IO () +attachShader prog shader = glAttachShader (getProgram prog) (getShader shader) + +-- | Detach the given GLSL from the given program. +detachShader :: GLSLProgram -> GLSLShader -> IO () +detachShader prog shader = glDetachShader (getProgram prog) (getShader shader) + +-- | Load a shader from the file specified by the given string. +-- +-- This function creates a new shader. To load source code into an existing shader, +-- see 'loadSource', 'shaderSource' and 'readSource'. +loadShader :: FilePath -> ShaderType -> Game s GLSLShader +loadShader file shaderType = do + shader <- newShader shaderType + loadSource file shader + compile file shader + return shader + +-- | Create a new shader. +newShader :: ShaderType -> Game s GLSLShader +newShader shaderType = do + h <- gameIO $ glCreateShader (toGLShader shaderType) + case h of + 0 -> gameError "glCreateShader failed" + _ -> do + rkey <- register $ deleteShader h + return $ GLSLShader h rkey + +-- | Free the shader. +deleteShader :: GLuint -> IO () +--deleteShader = glDeleteShader +deleteShader shader = do + putStrLn $ "Deleting shader " ++ show shader + glDeleteShader shader + +-- | Load a shader source from the file specified by the given string +-- into the shader. +loadSource :: FilePath -> GLSLShader -> Game s () +loadSource file h = do + exists <- gameIO $ doesFileExist file + case exists of + False -> gameError "the specified shader file does not exist" + True -> gameIO $ do + code <- readSource file + withCString code $ shaderSource h + +-- | Load the given shader source into the shader. +shaderSource :: GLSLShader -> CString -> IO () +shaderSource shader str = + let ptr = unsafeCoerce str + in withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr + +-- | Compile the shader. +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 + result <- peek statusPtr + 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 () + +getStatus :: StatusCall -> LogCall -> GLuint -> IO String +getStatus getStatus getLog h = do + alloca $ \lenPtr -> do + getStatus h gl_INFO_LOG_LENGTH lenPtr + len <- peek lenPtr + case len of + 0 -> return "" + _ -> withCString (replicate (unsafeCoerce len) '\0') $ getErrorString getLog h (unsafeCoerce len) + +getErrorString :: LogCall -> GLuint -> GLsizei -> CString -> IO String +getErrorString getLog h len str = do + let ptr = unsafeCoerce str + getLog h len nullPtr ptr + peekCString str + +-- | Load the shader source specified by the given file. +-- +-- This function implements an #include mechanism, so the given file can +-- refer to other files. +readSource :: FilePath -> IO String +readSource = fmap B.unpack . readSource' + +readSource' :: FilePath -> IO B.ByteString +readSource' file = do + let includeB = B.pack "#include" + newLineB = B.pack "\n" + isInclude = ((==) includeB) . B.take 8 + clean = B.dropWhile (\c -> c == ' ') + cleanInclude = B.filter (\c -> c /= '"') . B.dropWhile (\c -> c /= ' ') + toLines = B.splitWith (\c -> c == '\n' || c == '\r') + addNewLine s = if (B.last s /= '\n') then B.append s newLineB else s + parse = fmap B.concat . (fmap . fmap $ flip B.append newLineB) . sequence . + fmap (processLine . clean) . toLines + processLine l = + 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. +uniformVec2 :: GLint -> Vector2 -> IO () +uniformVec2 loc v = glUniform2f loc x' y' + where x' = unsafeCoerce $ x v + y' = unsafeCoerce $ y v + +-- | Load a 3D vector. +uniformVec3 :: GLint -> Vector3 -> IO () +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' + where x' = unsafeCoerce $ x v + y' = unsafeCoerce $ y v + z' = unsafeCoerce $ z v + w' = unsafeCoerce $ w v + +-- | Load a 3x3 matrix. +uniformMat3 :: GLint -> Matrix3 -> IO () +uniformMat3 loc mat = + with mat $ \ptrMat -> + glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) + +-- | Load a 4x4 matrix. +uniformMat4 :: GLint -> Matrix4 -> IO () +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 + +-- +-- VAOs +-- + +-- | A vertex array object. +data VAO = VAO + { getVAO :: GLuint + , vaoKey :: Resource + } + +instance ResourceClass VAO where + getResource = vaoKey + +instance Eq VAO where + vao1 == vao2 = getVAO vao1 == getVAO vao2 + +instance Ord VAO where + vao1 < vao2 = getVAO vao1 < getVAO vao2 + +-- | Create a new vao. +newVAO :: Game s VAO +newVAO = do + h <- gameIO . alloca $ \ptr -> do + glGenVertexArrays 1 ptr + peek ptr + + rkey <- register $ deleteVAO h + return $ VAO h rkey + +-- | Delete the vao. +deleteVAO :: GLuint -> IO () +deleteVAO vao = Foreign.with vao $ glDeleteVertexArrays 1 + +-- | Bind the vao. +bindVAO :: VAO -> IO () +bindVAO = glBindVertexArray . getVAO + +-- | Enable the given vertex attribute of the bound vao. +-- +-- See also 'bindVAO'. +enableVAOAttrib :: GLuint -- ^ Attribute index. + -> IO () +enableVAOAttrib = glEnableVertexAttribArray + +-- | Bind the bound buffer to the given point. +attribVAOPointer + :: GLuint -- ^ The index of the generic vertex attribute to be modified. + -> GLint -- ^ The number of components per generic vertex attribute. Must be 1,2,3,4. + -> GLenum -- ^ The data type of each component in the array. + -> Bool -- ^ Whether fixed-point data values should be normalized. + -> GLsizei -- ^ Stride. Byte offset between consecutive generic vertex attributes. + -> Int -- ^ Offset to the first component in the array. + -> IO () +attribVAOPointer idx ncomp dattype normalise stride off = + glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off) + +-- | Draw the bound vao. +drawArrays + :: GLenum -- ^ The kind of primitives to render. + -> Int -- ^ Starting index in the enabled arrays. + -> Int -- ^ The number of indices to be rendered. + -> IO () +drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count) + +-- | Draw the bound vao, indexed mode. +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. + -> 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 + +-- +-- BUFFER +-- + +-- | An OpenGL buffer. +data GLBuffer = GLBuffer + { getBuffer :: GLuint + , rkey :: Resource + } + +instance ResourceClass GLBuffer where + getResource = rkey + +-- | The type of target buffer. +data TargetBuffer + = ArrayBuffer + | ElementArrayBuffer + | PixelPackBuffer + | PixelUnpackBuffer + deriving (Eq, Show) + +fromTarget :: TargetBuffer -> GLenum +fromTarget ArrayBuffer = gl_ARRAY_BUFFER +fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER +fromTarget PixelPackBuffer = gl_PIXEL_PACK_BUFFER +fromTarget PixelUnpackBuffer = gl_PIXEL_UNPACK_BUFFER + +-- | A buffer usage. +data BufferUsage + = StreamDraw + | StreamRead + | StreamCopy + | StaticDraw + | StaticRead + | StaticCopy + | DynamicDraw + | DynamicRead + | DynamicCopy + deriving (Eq, Show) + +fromUsage :: BufferUsage -> GLenum +fromUsage StreamDraw = gl_STREAM_DRAW +fromUsage StreamRead = gl_STREAM_READ +fromUsage StreamCopy = gl_STREAM_COPY +fromUsage StaticDraw = gl_STATIC_DRAW +fromUsage StaticRead = gl_STATIC_READ +fromUsage StaticCopy = gl_STATIC_COPY +fromUsage DynamicDraw = gl_DYNAMIC_DRAW +fromUsage DynamicRead = gl_DYNAMIC_READ +fromUsage DynamicCopy = gl_DYNAMIC_COPY + +-- | Create a new buffer. +newBuffer :: Game s GLBuffer +newBuffer = do + h <- gameIO . alloca $ \ptr -> do + glGenBuffers 1 ptr + peek ptr + + rkey <- register $ deleteBuffer h + return $ GLBuffer h rkey + +-- | Delete the buffer. +deleteBuffer :: GLuint -> IO () +deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1 + +-- | Bind the buffer. +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 + -> BufferUsage + -> IO () +bufferData target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage 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. + -> BufferUsage + -> IO () +bufferDatal target n bufData usage = withArray bufData $ + \ptr -> bufferData target (n * length bufData) ptr usage + +-- | Apply the given function the buffer's id. +withGLBuffer :: GLBuffer -> (GLuint -> a) -> a +withGLBuffer buf f = f $ getBuffer buf + +-- +-- TEXTURE +-- + +-- | Represents a texture resource. +data Texture = Texture + { getTex :: GLuint + , texKey :: Resource + } + +instance Eq Texture where + t1 == t2 = getTex t1 == getTex t2 + +instance Ord Texture where + t1 < t2 = getTex t1 < getTex t2 + +instance ResourceClass Texture where + getResource = texKey + +-- | Create a new texture. +newTexture :: Game s Texture +newTexture = do + tex <- gameIO . alloca $ \ptr -> do + glGenTextures 1 ptr + peek ptr + + rkey <- register $ deleteTexture tex + return $ Texture tex rkey + +-- | Delete the texture. +deleteTexture :: GLuint -> IO () +--deleteTexture tex = with tex $ glDeleteTextures 1 +deleteTexture tex = do + putStrLn $ "Releasing texture " ++ show tex + with tex $ glDeleteTextures 1 + +-- | Load the 'Texture' specified by the given file. +loadTextureImage :: FilePath + -> GLenum -- ^ Texture's min filter. + -> GLenum -- ^ Texture's mag filter. + -> Game s Texture +loadTextureImage file minFilter magFilter = do + image <- loadImage file + tex <- newTexture + gameIO $ do + let w = width image + 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. +bindTexture :: Texture -> IO () +bindTexture = glBindTexture gl_TEXTURE_2D . getTex + +-- | Load data onto the bound texture. +-- +-- See also 'bindTexture'. +loadTextureData :: GLenum + -> Int -- ^ Target + -> Int -- ^ Level + -> Int -- ^ Internal format + -> Int -- ^ Width + -> Int -- ^ Height + -> GLenum -- ^ Border + -> GLenum -- ^ Texture type + -> Ptr a -- ^ Texture data + -> IO () +loadTextureData target level internalFormat width height border format texType texData = do + glTexImage2D target + (fromIntegral level) + (fromIntegral internalFormat) + (fromIntegral width) + (fromIntegral height) + (fromIntegral border) + (fromIntegral format) + texType + texData + +-- | Set the bound texture's parameter to the given value. +texParami :: GLenum -> GLenum -> SettableStateVar GLenum +texParami target param = makeSettableStateVar $ \val -> glTexParameteri target param $ fromIntegral . fromEnum $ val + +-- | Set the bound texture's parameter to the given value. +texParamf :: GLenum -> GLenum -> SettableStateVar Float +texParamf target param = makeSettableStateVar $ \val -> glTexParameterf target param (unsafeCoerce val) + +-- | Set the active texture unit. +activeTexture :: SettableStateVar GLenum +activeTexture = makeSettableStateVar glActiveTexture + +-- +-- ERROR +-- + +-- | Get the last OpenGL error. +getGLError :: IO (Maybe String) +getGLError = fmap translate glGetError + where + translate err + | err == gl_NO_ERROR = Nothing + | err == gl_INVALID_ENUM = Just "Invalid enum" + | err == gl_INVALID_VALUE = Just "Invalid value" + | err == gl_INVALID_OPERATION = Just "Invalid operation" + | err == gl_OUT_OF_MEMORY = Just "Out of memory" + | otherwise = Just "Unknown error" + +-- | Print the last OpenGL error. +printGLError :: IO () +printGLError = getGLError >>= \err -> case err of + Nothing -> return () + Just str -> hPutStrLn stderr str + +-- | Run the given setup action and check for OpenGL errors. +-- +-- If an OpenGL error is produced, an exception is thrown containing +-- the given string appended to the string describing the error. +assertGL :: Game s a -> String -> Game s a +assertGL action err = do + result <- action + status <- gameIO getGLError + case status of + Just str -> gameError $ "OpenGL error raised: " ++ err ++ "; " ++ str + Nothing -> return result diff --git a/Spear/GLSL.hs b/Spear/GLSL.hs deleted file mode 100644 index 8541e1f..0000000 --- a/Spear/GLSL.hs +++ /dev/null @@ -1,672 +0,0 @@ -module Spear.GLSL -( - -- * General Management - GLSLShader -, GLSLProgram -, ShaderType(..) - -- ** Programs -, newProgram -, linkProgram -, useProgram -, withGLSLProgram - -- ** Shaders -, attachShader -, detachShader -, loadShader -, newShader - -- *** Source loading -, loadSource -, shaderSource -, readSource -, compile - -- ** Locations -, attribLocation -, fragLocation -, uniformLocation - -- ** Uniforms -, uniformVec2 -, uniformVec3 -, uniformVec4 -, uniformMat3 -, uniformMat4 -, uniformfl -, uniformil - -- ** Helper functions -, ($=) -, Data.StateVar.get - -- * VAOs -, VAO - -- ** Creation and destruction -, newVAO - -- ** Manipulation -, bindVAO -, enableVAOAttrib -, attribVAOPointer - -- ** Rendering -, drawArrays -, drawElements - -- * Buffers -, GLBuffer -, TargetBuffer(..) -, BufferUsage(..) - -- ** Creation and destruction -, newBuffer - -- ** Manipulation -, bindBuffer -, bufferData -, bufferDatal -, withGLBuffer - -- * Textures -, Texture -, SettableStateVar -, ($) - -- ** Creation and destruction -, newTexture -, loadTextureImage - -- ** Manipulation -, bindTexture -, loadTextureData -, texParami -, texParamf -, activeTexture - -- * Error Handling -, getGLError -, printGLError -, assertGL - -- * OpenGL -, module Graphics.Rendering.OpenGL.Raw.Core31 -, Ptr -, nullPtr -) -where - -import Spear.Assets.Image -import Spear.Game -import Spear.Math.Matrix3 (Matrix3) -import Spear.Math.Matrix4 (Matrix4) -import Spear.Math.Vector - -import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.Error -import Control.Monad.Trans.State as State -import qualified Data.ByteString.Char8 as B -import Data.StateVar -import Foreign.C.String -import Foreign.Ptr -import Foreign.Storable -import Foreign.Marshal.Utils as Foreign (with) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Marshal.Array (withArray) -import Foreign.Storable (peek) -import Graphics.Rendering.OpenGL.Raw.Core31 -import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory) -import System.IO (hPutStrLn, stderr) -import Unsafe.Coerce - --- --- MANAGEMENT --- - --- | A GLSL shader handle. -data GLSLShader = GLSLShader - { getShader :: GLuint - , getShaderKey :: Resource - } - -instance ResourceClass GLSLShader where - getResource = getShaderKey - --- | A GLSL program handle. -data GLSLProgram = GLSLProgram - { getProgram :: GLuint - , getProgramKey :: Resource - } - -instance ResourceClass GLSLProgram where - getResource = getProgramKey - --- | Supported shader types. -data ShaderType = VertexShader | FragmentShader deriving (Eq, Show) - -toGLShader :: ShaderType -> GLenum -toGLShader VertexShader = gl_VERTEX_SHADER -toGLShader FragmentShader = gl_FRAGMENT_SHADER - --- | Apply the given function to the program's id. -withGLSLProgram :: GLSLProgram -> (GLuint -> a) -> a -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) - --- | Get or set the location of the given variable to a fragment shader colour number. -fragLocation :: GLSLProgram -> String -> StateVar GLint -fragLocation prog var = makeStateVar get set - where - get = withCString var $ \str -> glGetFragDataLocation (getProgram prog) (unsafeCoerce str) - set idx = withCString var $ \str -> - glBindFragDataLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str) - --- | Get or set the location of the given attribute within the given program. -attribLocation :: GLSLProgram -> String -> StateVar GLint -attribLocation prog var = makeStateVar get set - where - get = withCString var $ \str -> glGetAttribLocation (getProgram prog) (unsafeCoerce str) - set idx = withCString var $ \str -> - glBindAttribLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str) - --- | Create a new program. -newProgram :: [GLSLShader] -> Game s GLSLProgram -newProgram shaders = do - h <- gameIO glCreateProgram - 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. -deleteProgram :: GLuint -> IO () ---deleteProgram = glDeleteProgram -deleteProgram prog = do - putStrLn $ "Deleting shader program " ++ show prog - glDeleteProgram prog - --- | Link the program. -linkProgram :: GLSLProgram -> Game s () -linkProgram prog = do - let h = getProgram prog - err <- gameIO $ do - glLinkProgram h - alloca $ \statptr -> do - glGetProgramiv h gl_LINK_STATUS statptr - status <- peek statptr - case status of - 0 -> getStatus glGetProgramiv glGetProgramInfoLog h - _ -> return "" - - case length err of - 0 -> return () - _ -> gameError err - --- | Use the program. -useProgram :: GLSLProgram -> IO () -useProgram prog = glUseProgram $ getProgram prog - --- | Attach the given shader to the given program. -attachShader :: GLSLProgram -> GLSLShader -> IO () -attachShader prog shader = glAttachShader (getProgram prog) (getShader shader) - --- | Detach the given GLSL from the given program. -detachShader :: GLSLProgram -> GLSLShader -> IO () -detachShader prog shader = glDetachShader (getProgram prog) (getShader shader) - --- | Load a shader from the file specified by the given string. --- --- This function creates a new shader. To load source code into an existing shader, --- see 'loadSource', 'shaderSource' and 'readSource'. -loadShader :: FilePath -> ShaderType -> Game s GLSLShader -loadShader file shaderType = do - shader <- newShader shaderType - loadSource file shader - compile file shader - return shader - --- | Create a new shader. -newShader :: ShaderType -> Game s GLSLShader -newShader shaderType = do - h <- gameIO $ glCreateShader (toGLShader shaderType) - case h of - 0 -> gameError "glCreateShader failed" - _ -> do - rkey <- register $ deleteShader h - return $ GLSLShader h rkey - --- | Free the shader. -deleteShader :: GLuint -> IO () ---deleteShader = glDeleteShader -deleteShader shader = do - putStrLn $ "Deleting shader " ++ show shader - glDeleteShader shader - --- | Load a shader source from the file specified by the given string --- into the shader. -loadSource :: FilePath -> GLSLShader -> Game s () -loadSource file h = do - exists <- gameIO $ doesFileExist file - case exists of - False -> gameError "the specified shader file does not exist" - True -> gameIO $ do - code <- readSource file - withCString code $ shaderSource h - --- | Load the given shader source into the shader. -shaderSource :: GLSLShader -> CString -> IO () -shaderSource shader str = - let ptr = unsafeCoerce str - in withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr - --- | Compile the shader. -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 - result <- peek statusPtr - 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 () - -getStatus :: StatusCall -> LogCall -> GLuint -> IO String -getStatus getStatus getLog h = do - alloca $ \lenPtr -> do - getStatus h gl_INFO_LOG_LENGTH lenPtr - len <- peek lenPtr - case len of - 0 -> return "" - _ -> withCString (replicate (unsafeCoerce len) '\0') $ getErrorString getLog h (unsafeCoerce len) - -getErrorString :: LogCall -> GLuint -> GLsizei -> CString -> IO String -getErrorString getLog h len str = do - let ptr = unsafeCoerce str - getLog h len nullPtr ptr - peekCString str - --- | Load the shader source specified by the given file. --- --- This function implements an #include mechanism, so the given file can --- refer to other files. -readSource :: FilePath -> IO String -readSource = fmap B.unpack . readSource' - -readSource' :: FilePath -> IO B.ByteString -readSource' file = do - let includeB = B.pack "#include" - newLineB = B.pack "\n" - isInclude = ((==) includeB) . B.take 8 - clean = B.dropWhile (\c -> c == ' ') - cleanInclude = B.filter (\c -> c /= '"') . B.dropWhile (\c -> c /= ' ') - toLines = B.splitWith (\c -> c == '\n' || c == '\r') - addNewLine s = if (B.last s /= '\n') then B.append s newLineB else s - parse = fmap B.concat . (fmap . fmap $ flip B.append newLineB) . sequence . - fmap (processLine . clean) . toLines - processLine l = - 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. -uniformVec2 :: GLint -> Vector2 -> IO () -uniformVec2 loc v = glUniform2f loc x' y' - where x' = unsafeCoerce $ x v - y' = unsafeCoerce $ y v - --- | Load a 3D vector. -uniformVec3 :: GLint -> Vector3 -> IO () -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' - where x' = unsafeCoerce $ x v - y' = unsafeCoerce $ y v - z' = unsafeCoerce $ z v - w' = unsafeCoerce $ w v - --- | Load a 3x3 matrix. -uniformMat3 :: GLint -> Matrix3 -> IO () -uniformMat3 loc mat = - with mat $ \ptrMat -> - glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) - --- | Load a 4x4 matrix. -uniformMat4 :: GLint -> Matrix4 -> IO () -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 - --- --- VAOs --- - --- | A vertex array object. -data VAO = VAO - { getVAO :: GLuint - , vaoKey :: Resource - } - -instance ResourceClass VAO where - getResource = vaoKey - -instance Eq VAO where - vao1 == vao2 = getVAO vao1 == getVAO vao2 - -instance Ord VAO where - vao1 < vao2 = getVAO vao1 < getVAO vao2 - --- | Create a new vao. -newVAO :: Game s VAO -newVAO = do - h <- gameIO . alloca $ \ptr -> do - glGenVertexArrays 1 ptr - peek ptr - - rkey <- register $ deleteVAO h - return $ VAO h rkey - --- | Delete the vao. -deleteVAO :: GLuint -> IO () -deleteVAO vao = Foreign.with vao $ glDeleteVertexArrays 1 - --- | Bind the vao. -bindVAO :: VAO -> IO () -bindVAO = glBindVertexArray . getVAO - --- | Enable the given vertex attribute of the bound vao. --- --- See also 'bindVAO'. -enableVAOAttrib :: GLuint -- ^ Attribute index. - -> IO () -enableVAOAttrib = glEnableVertexAttribArray - --- | Bind the bound buffer to the given point. -attribVAOPointer - :: GLuint -- ^ The index of the generic vertex attribute to be modified. - -> GLint -- ^ The number of components per generic vertex attribute. Must be 1,2,3,4. - -> GLenum -- ^ The data type of each component in the array. - -> Bool -- ^ Whether fixed-point data values should be normalized. - -> GLsizei -- ^ Stride. Byte offset between consecutive generic vertex attributes. - -> Int -- ^ Offset to the first component in the array. - -> IO () -attribVAOPointer idx ncomp dattype normalise stride off = - glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off) - --- | Draw the bound vao. -drawArrays - :: GLenum -- ^ The kind of primitives to render. - -> Int -- ^ Starting index in the enabled arrays. - -> Int -- ^ The number of indices to be rendered. - -> IO () -drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count) - --- | Draw the bound vao, indexed mode. -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. - -> 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 - --- --- BUFFER --- - --- | An OpenGL buffer. -data GLBuffer = GLBuffer - { getBuffer :: GLuint - , rkey :: Resource - } - -instance ResourceClass GLBuffer where - getResource = rkey - --- | The type of target buffer. -data TargetBuffer - = ArrayBuffer - | ElementArrayBuffer - | PixelPackBuffer - | PixelUnpackBuffer - deriving (Eq, Show) - -fromTarget :: TargetBuffer -> GLenum -fromTarget ArrayBuffer = gl_ARRAY_BUFFER -fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER -fromTarget PixelPackBuffer = gl_PIXEL_PACK_BUFFER -fromTarget PixelUnpackBuffer = gl_PIXEL_UNPACK_BUFFER - --- | A buffer usage. -data BufferUsage - = StreamDraw - | StreamRead - | StreamCopy - | StaticDraw - | StaticRead - | StaticCopy - | DynamicDraw - | DynamicRead - | DynamicCopy - deriving (Eq, Show) - -fromUsage :: BufferUsage -> GLenum -fromUsage StreamDraw = gl_STREAM_DRAW -fromUsage StreamRead = gl_STREAM_READ -fromUsage StreamCopy = gl_STREAM_COPY -fromUsage StaticDraw = gl_STATIC_DRAW -fromUsage StaticRead = gl_STATIC_READ -fromUsage StaticCopy = gl_STATIC_COPY -fromUsage DynamicDraw = gl_DYNAMIC_DRAW -fromUsage DynamicRead = gl_DYNAMIC_READ -fromUsage DynamicCopy = gl_DYNAMIC_COPY - --- | Create a new buffer. -newBuffer :: Game s GLBuffer -newBuffer = do - h <- gameIO . alloca $ \ptr -> do - glGenBuffers 1 ptr - peek ptr - - rkey <- register $ deleteBuffer h - return $ GLBuffer h rkey - --- | Delete the buffer. -deleteBuffer :: GLuint -> IO () -deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1 - --- | Bind the buffer. -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 - -> BufferUsage - -> IO () -bufferData target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage 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. - -> BufferUsage - -> IO () -bufferDatal target n bufData usage = withArray bufData $ - \ptr -> bufferData target (n * length bufData) ptr usage - --- | Apply the given function the buffer's id. -withGLBuffer :: GLBuffer -> (GLuint -> a) -> a -withGLBuffer buf f = f $ getBuffer buf - --- --- TEXTURE --- - --- | Represents a texture resource. -data Texture = Texture - { getTex :: GLuint - , texKey :: Resource - } - -instance Eq Texture where - t1 == t2 = getTex t1 == getTex t2 - -instance Ord Texture where - t1 < t2 = getTex t1 < getTex t2 - -instance ResourceClass Texture where - getResource = texKey - --- | Create a new texture. -newTexture :: Game s Texture -newTexture = do - tex <- gameIO . alloca $ \ptr -> do - glGenTextures 1 ptr - peek ptr - - rkey <- register $ deleteTexture tex - return $ Texture tex rkey - --- | Delete the texture. -deleteTexture :: GLuint -> IO () ---deleteTexture tex = with tex $ glDeleteTextures 1 -deleteTexture tex = do - putStrLn $ "Releasing texture " ++ show tex - with tex $ glDeleteTextures 1 - --- | Load the 'Texture' specified by the given file. -loadTextureImage :: FilePath - -> GLenum -- ^ Texture's min filter. - -> GLenum -- ^ Texture's mag filter. - -> Game s Texture -loadTextureImage file minFilter magFilter = do - image <- loadImage file - tex <- newTexture - gameIO $ do - let w = width image - 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. -bindTexture :: Texture -> IO () -bindTexture = glBindTexture gl_TEXTURE_2D . getTex - --- | Load data onto the bound texture. --- --- See also 'bindTexture'. -loadTextureData :: GLenum - -> Int -- ^ Target - -> Int -- ^ Level - -> Int -- ^ Internal format - -> Int -- ^ Width - -> Int -- ^ Height - -> GLenum -- ^ Border - -> GLenum -- ^ Texture type - -> Ptr a -- ^ Texture data - -> IO () -loadTextureData target level internalFormat width height border format texType texData = do - glTexImage2D target - (fromIntegral level) - (fromIntegral internalFormat) - (fromIntegral width) - (fromIntegral height) - (fromIntegral border) - (fromIntegral format) - texType - texData - --- | Set the bound texture's parameter to the given value. -texParami :: GLenum -> GLenum -> SettableStateVar GLenum -texParami target param = makeSettableStateVar $ \val -> glTexParameteri target param $ fromIntegral . fromEnum $ val - --- | Set the bound texture's parameter to the given value. -texParamf :: GLenum -> GLenum -> SettableStateVar Float -texParamf target param = makeSettableStateVar $ \val -> glTexParameterf target param (unsafeCoerce val) - --- | Set the active texture unit. -activeTexture :: SettableStateVar GLenum -activeTexture = makeSettableStateVar glActiveTexture - --- --- ERROR --- - --- | Get the last OpenGL error. -getGLError :: IO (Maybe String) -getGLError = fmap translate glGetError - where - translate err - | err == gl_NO_ERROR = Nothing - | err == gl_INVALID_ENUM = Just "Invalid enum" - | err == gl_INVALID_VALUE = Just "Invalid value" - | err == gl_INVALID_OPERATION = Just "Invalid operation" - | err == gl_OUT_OF_MEMORY = Just "Out of memory" - | otherwise = Just "Unknown error" - --- | Print the last OpenGL error. -printGLError :: IO () -printGLError = getGLError >>= \err -> case err of - Nothing -> return () - Just str -> hPutStrLn stderr str - --- | Run the given setup action and check for OpenGL errors. --- --- If an OpenGL error is produced, an exception is thrown containing --- the given string appended to the string describing the error. -assertGL :: Game s a -> String -> Game s a -assertGL action err = do - result <- action - status <- gameIO getGLError - case status of - Just str -> gameError $ "OpenGL error raised: " ++ err ++ "; " ++ str - Nothing -> return result diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs index e554272..be3e2e3 100644 --- a/Spear/Render/AnimatedModel.hs +++ b/Spear/Render/AnimatedModel.hs @@ -30,7 +30,7 @@ where import Spear.Assets.Model import Spear.Collision import Spear.Game -import Spear.GLSL +import Spear.GL import Spear.Math.AABB import Spear.Math.Matrix4 (Matrix4) import Spear.Math.Vector diff --git a/Spear/Render/Program.hs b/Spear/Render/Program.hs index ab2a548..6e94ca5 100644 --- a/Spear/Render/Program.hs +++ b/Spear/Render/Program.hs @@ -11,34 +11,28 @@ module Spear.Render.Program ) where - -import Spear.GLSL (GLSLProgram) - +import Spear.GL (GLSLProgram) import Graphics.Rendering.OpenGL.Raw.Core31 - data StaticProgram = StaticProgram { staticProgram :: GLSLProgram , staticProgramChannels :: StaticProgramChannels , staticProgramUniforms :: StaticProgramUniforms } - data AnimatedProgram = AnimatedProgram { animatedProgram :: GLSLProgram , animatedProgramChannels :: AnimatedProgramChannels , animatedProgramUniforms :: AnimatedProgramUniforms } - data StaticProgramChannels = StaticProgramChannels { vertexChannel :: GLuint -- ^ Vertex channel. , normalChannel :: GLuint -- ^ Normal channel. , stexChannel :: GLuint -- ^ Texture channel. } - data AnimatedProgramChannels = AnimatedProgramChannels { vertexChannel1 :: GLuint -- ^ Vertex channel 1. , vertexChannel2 :: GLuint -- ^ Vertex channel 2. @@ -47,7 +41,6 @@ data AnimatedProgramChannels = AnimatedProgramChannels , atexChannel :: GLuint -- ^ Texture channel. } - data StaticProgramUniforms = StaticProgramUniforms { skaLoc :: GLint -- ^ Material ambient uniform location. , skdLoc :: GLint -- ^ Material diffuse uniform location. @@ -59,7 +52,6 @@ data StaticProgramUniforms = StaticProgramUniforms , sprojLoc :: GLint -- ^ Projection matrix location. } - data AnimatedProgramUniforms = AnimatedProgramUniforms { akaLoc :: GLint -- ^ Material ambient uniform location. , akdLoc :: GLint -- ^ Material diffuse uniform location. @@ -72,19 +64,15 @@ data AnimatedProgramUniforms = AnimatedProgramUniforms , aprojLoc :: GLint -- ^ Projection matrix location. } - class Program a where program :: a -> GLSLProgram - instance Program StaticProgram where program = staticProgram - instance Program AnimatedProgram where program = animatedProgram - class ProgramUniforms a where kaLoc :: a -> GLint kdLoc :: a -> GLint @@ -95,7 +83,6 @@ class ProgramUniforms a where normalmatLoc :: a -> GLint projLoc :: a -> GLint - instance ProgramUniforms StaticProgramUniforms where kaLoc = skaLoc kdLoc = skdLoc @@ -106,8 +93,6 @@ instance ProgramUniforms StaticProgramUniforms where normalmatLoc = snormalmatLoc projLoc = sprojLoc - - instance ProgramUniforms AnimatedProgramUniforms where kaLoc = akaLoc kdLoc = akdLoc diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs index fc7006e..42cf9d0 100644 --- a/Spear/Render/StaticModel.hs +++ b/Spear/Render/StaticModel.hs @@ -20,7 +20,7 @@ where import Spear.Assets.Model import Spear.Collision import Spear.Game -import Spear.GLSL +import Spear.GL import Spear.Math.AABB import Spear.Math.Matrix4 (Matrix4) import Spear.Math.Vector diff --git a/Spear/Scene/GameObject.hs b/Spear/Scene/GameObject.hs index 37f9260..b981c00 100644 --- a/Spear/Scene/GameObject.hs +++ b/Spear/Scene/GameObject.hs @@ -32,7 +32,7 @@ where import Spear.Collision as Col -import Spear.GLSL +import Spear.GL import Spear.Math.AABB import qualified Spear.Math.Camera as Cam import qualified Spear.Math.Matrix3 as M3 diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs index 09d69eb..22657bd 100644 --- a/Spear/Scene/Loader.hs +++ b/Spear/Scene/Loader.hs @@ -20,7 +20,7 @@ where import Spear.Assets.Model as Model import Spear.Collision import Spear.Game -import qualified Spear.GLSL as GLSL +import qualified Spear.GL as GL import Spear.Math.Matrix3 as M3 import Spear.Math.Matrix4 as M4 import Spear.Math.MatrixUtils (fastNormalMatrix) @@ -201,20 +201,20 @@ rotateModel (Rotation ax ay az order) model = in flip Model.transformVerts vTransform . flip Model.transformNormals nTransform $ model -loadTexture :: FilePath -> Loader GLSL.Texture +loadTexture :: FilePath -> Loader GL.Texture loadTexture file = loadResource file textures addTexture $ - GLSL.loadTextureImage file gl_LINEAR gl_LINEAR + GL.loadTextureImage file gl_LINEAR gl_LINEAR newShaderProgram :: SceneGraph -> Loader () newShaderProgram (SceneLeaf _ props) = do - (vsName, vertShader) <- Spear.Scene.Loader.loadShader GLSL.VertexShader props - (fsName, fragShader) <- Spear.Scene.Loader.loadShader GLSL.FragmentShader props + (vsName, vertShader) <- Spear.Scene.Loader.loadShader GL.VertexShader props + (fsName, fragShader) <- Spear.Scene.Loader.loadShader GL.FragmentShader props name <- asString $ mandatory' "name" props stype <- asString $ mandatory' "type" props - prog <- GLSL.newProgram [vertShader, fragShader] + prog <- GL.newProgram [vertShader, fragShader] - let getUniformLoc name = (gameIO . SV.get $ GLSL.uniformLocation prog name) `GLSL.assertGL` name + let getUniformLoc name = (gameIO . SV.get $ GL.uniformLocation prog name) `GL.assertGL` name case stype of "static" -> do @@ -285,17 +285,17 @@ newShaderProgram (SceneLeaf _ props) = do loadResource name customPrograms addCustomProgram $ return prog return () -loadShader :: GLSL.ShaderType -> [Property] -> Loader (String, GLSL.GLSLShader) +loadShader :: GL.ShaderType -> [Property] -> Loader (String, GL.GLSLShader) loadShader _ [] = gameError $ "Loader::vertexShader: empty list" loadShader shaderType ((stype, file):xs) = - if shaderType == GLSL.VertexShader && stype == "vertex-shader" || - shaderType == GLSL.FragmentShader && stype == "fragment-shader" + if shaderType == GL.VertexShader && stype == "vertex-shader" || + shaderType == GL.FragmentShader && stype == "fragment-shader" then let f = concat file in loadShader' f shaderType >>= \shader -> return (f, shader) else Spear.Scene.Loader.loadShader shaderType xs -loadShader' :: String -> GLSL.ShaderType -> Loader GLSL.GLSLShader -loadShader' file shaderType = loadResource file shaders addShader $ GLSL.loadShader file shaderType +loadShader' :: String -> GL.ShaderType -> Loader GL.GLSLShader +loadShader' file shaderType = loadResource file shaders addShader $ GL.loadShader file shaderType newLight :: SceneGraph -> Loader () newLight _ = return () diff --git a/Spear/Scene/SceneResources.hs b/Spear/Scene/SceneResources.hs index c2dabcf..d75db56 100644 --- a/Spear/Scene/SceneResources.hs +++ b/Spear/Scene/SceneResources.hs @@ -17,9 +17,8 @@ module Spear.Scene.SceneResources ) where - import Spear.Assets.Model as Model -import Spear.GLSL as GLSL +import Spear.GL as GL import Spear.Math.Vector import Spear.Render.AnimatedModel import Spear.Render.Material @@ -29,7 +28,6 @@ import Spear.Scene.Light import Data.Map as M - data SceneResources = SceneResources { shaders :: Map String GLSLShader , customPrograms :: Map String GLSLProgram @@ -41,42 +39,34 @@ data SceneResources = SceneResources , lights :: [Light] } - -- | Build an empty instance of 'SceneResources'. emptySceneResources = SceneResources M.empty M.empty M.empty M.empty M.empty M.empty M.empty [] - -- | Get the shader specified by the given string. getShader :: SceneResources -> String -> Maybe GLSLShader getShader res key = M.lookup key $ shaders res - -- | Get the custom program specified by the given string. getCustomProgram :: SceneResources -> String -> Maybe GLSLProgram getCustomProgram res key = M.lookup key $ customPrograms res - -- | Get the static program specified by the given string. getStaticProgram :: SceneResources -> String -> Maybe StaticProgram getStaticProgram res key = M.lookup key $ staticPrograms res - -- | Get the animated program specified by the given string. getAnimatedProgram :: SceneResources -> String -> Maybe AnimatedProgram getAnimatedProgram res key = M.lookup key $ animatedPrograms res - -- | Get the texture specified by the given string. getTexture :: SceneResources -> String -> Maybe Texture getTexture res key = M.lookup key $ textures res - -- | Get the static model resource specified by the given string. getStaticModel :: SceneResources -> String -> Maybe StaticModelResource getStaticModel res key = M.lookup key $ staticModels res - -- | Get the animated model resource specified by the given string. getAnimatedModel :: SceneResources -> String -> Maybe AnimatedModelResource getAnimatedModel res key = M.lookup key $ animatedModels res -- cgit v1.2.3