From 21cf357ac1f8d0bef6ed7d53d7f1b05b73484b8d Mon Sep 17 00:00:00 2001 From: Marc Sunet Date: Thu, 30 Aug 2012 19:18:41 +0200 Subject: Cleaned GLSL interface --- Spear.cabal | 29 +- Spear.lkshs | 10 +- Spear.lkshw | 6 +- Spear/GLSL.hs | 718 +++++++++++++++++++++++++++++++++++++++++++++- Spear/GLSL/Buffer.hs | 111 ------- Spear/GLSL/Error.hs | 45 --- Spear/GLSL/Management.hs | 297 ------------------- Spear/GLSL/Texture.hs | 110 ------- Spear/GLSL/Uniform.hs | 67 ----- Spear/GLSL/VAO.hs | 88 ------ Spear/Render/Program.hs | 2 +- Spear/Render/Texture.hs | 2 +- Spear/Scene/GameObject.hs | 3 +- 13 files changed, 730 insertions(+), 758 deletions(-) delete mode 100644 Spear/GLSL/Buffer.hs delete mode 100644 Spear/GLSL/Error.hs delete mode 100644 Spear/GLSL/Management.hs delete mode 100644 Spear/GLSL/Texture.hs delete mode 100644 Spear/GLSL/Uniform.hs delete mode 100644 Spear/GLSL/VAO.hs diff --git a/Spear.cabal b/Spear.cabal index 01a2b23..1f32616 100644 --- a/Spear.cabal +++ b/Spear.cabal @@ -21,21 +21,20 @@ library Spear.Assets.Image Spear.Assets.Model Spear.Collision Spear.Math.AABB Spear.Collision.Collision Spear.Collision.Collisioner Spear.Math.Circle Spear.Math.Triangle - Spear.Collision.Types Spear.Game Spear.GLSL Spear.GLSL.Buffer - Spear.GLSL.Error Spear.GLSL.Management Spear.GLSL.Texture - Spear.GLSL.Uniform Spear.GLSL.VAO Spear.Math.Camera - Spear.Math.Entity Spear.Math.Matrix3 Spear.Math.Matrix4 - Spear.Math.MatrixUtils Spear.Math.Plane Spear.Math.Quaternion - Spear.Math.Vector3 Spear.Math.Vector4 - Spear.Physics Spear.Physics.Rigid Spear.Render.AnimatedModel - Spear.Render.Material Spear.Render.Model Spear.Render.Program - Spear.Render.Renderable Spear.Render.StaticModel - Spear.Render.Texture Spear.Scene.Graph Spear.Scene.Light - Spear.Scene.Loader Spear.Scene.Scene Spear.Scene.SceneResources - Spear.Setup Spear.Sys.Timer Spear.Sys.Store Spear.Sys.Store.ID - Spear.Updatable Spear.Math.Vector2 Spear.Math.Quad Spear.Math.Ray - Spear.Math.Segment Spear.Math.Utils - Spear.Math.Spatial2 Spear.Math.Spatial3 + Spear.Collision.Types Spear.Game Spear.GLSL Spear.Math.Camera + Spear.Math.Entity + Spear.Math.Matrix3 Spear.Math.Matrix4 Spear.Math.MatrixUtils + Spear.Math.Plane Spear.Math.Quaternion Spear.Math.Vector3 + Spear.Math.Vector4 Spear.Physics Spear.Physics.Rigid + Spear.Render.AnimatedModel Spear.Render.Material Spear.Render.Model + Spear.Render.Program Spear.Render.Renderable + Spear.Render.StaticModel Spear.Render.Texture Spear.Scene.Graph + Spear.Scene.Light Spear.Scene.Loader Spear.Scene.Scene + Spear.Scene.SceneResources Spear.Setup Spear.Sys.Timer + Spear.Sys.Store Spear.Sys.Store.ID Spear.Updatable + Spear.Math.Vector2 Spear.Math.Quad Spear.Math.Ray + Spear.Math.Segment Spear.Math.Utils Spear.Math.Spatial2 + Spear.Math.Spatial3 exposed: True buildable: True build-tools: hsc2hs -any diff --git a/Spear.lkshs b/Spear.lkshs index 6eb025a..bc27e60 100644 --- a/Spear.lkshs +++ b/Spear.lkshs @@ -1,18 +1,18 @@ Version of session file format: 1 Time of storage: - "Thu Aug 30 17:27:24 CEST 2012" -Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 311) 199)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 705) 954 -Population: [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Factory.hs" 1268)),[SplitP LeftP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Scene/GameObject.hs" 137)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Just (ModuleName ["Game","GameObject"]),Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0,1],[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Player.hs" 765)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Utils.hs" 649)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 5372)),[SplitP LeftP])] + "Thu Aug 30 18:49:02 CEST 2012" +Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 6, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 338) 215)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 760) 954 +Population: [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Factory.hs" 1268)),[SplitP LeftP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/GLSL.hs" 18361)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Scene/GameObject.hs" 137)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Scene/Loader.hs" 0)),[SplitP LeftP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Just (ModuleName ["Spear","GLSL","VAO"]),Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0,2],[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Player.hs" 765)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Utils.hs" 835)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 5372)),[SplitP LeftP])] Window size: (1820,939) Completion size: (750,399) Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" -Active pane: Just "Factory.hs" +Active pane: Just "main.hs" Toolbar visible: True FindbarState: (False,FindState {entryStr = "\170", entryHist = ["\170","\\","^","scale","Vector4.","asdad","translv","Vector3.","Vector.","copy_tr","asad","Octree"], replaceStr = "V3.", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) Recently opened files: - ["/home/jeanne/programming/haskell/Spear/Spear/Render/AnimatedModel.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.c","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/MD2/MD2_load.c","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Factory.hs","/home/jeanne/programming/haskell/Spear/Spear/App/Application.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c","/home/jeanne/programming/haskell/Spear/Spear/Scene/GameObject.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameState.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/StaticModel.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Camera.hs"] + ["/home/jeanne/programming/haskell/Spear/Spear/GLSL/VAO.hs","/home/jeanne/programming/haskell/Spear/Spear/GLSL/Uniform.hs","/home/jeanne/programming/haskell/Spear/Spear/GLSL/Texture.hs","/home/jeanne/programming/haskell/Spear/Spear/GLSL/Management.hs","/home/jeanne/programming/haskell/Spear/Spear/GLSL/Buffer.hs","/home/jeanne/programming/haskell/Spear/Spear/GLSL/Error.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/AnimatedModel.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.c","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/MD2/MD2_load.c","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Factory.hs","/home/jeanne/programming/haskell/Spear/Spear/App/Application.hs"] Recently opened workspaces: ["/home/jeanne/programming/haskell/hagen/hagen.lkshw","/home/jeanne/programming/haskell/foo/foo.lkshw","/home/jeanne/programming/haskell/Spear/Spear.lkshw","/home/jeanne/programming/haskell/nexus/nexus.lkshw","/home/jeanne/leksah.lkshw"] \ No newline at end of file diff --git a/Spear.lkshw b/Spear.lkshw index 8163407..656c982 100644 --- a/Spear.lkshw +++ b/Spear.lkshw @@ -1,10 +1,10 @@ Version of workspace file format: 1 Time of storage: - "Thu Aug 30 16:58:13 CEST 2012" + "Thu Aug 30 18:50:08 CEST 2012" Name of the workspace: "Spear" File paths of contained packages: - ["demos/simple-scene/simple-scene.cabal","Spear.cabal"] + ["Spear.cabal"] Maybe file path of an active package: - Just "demos/simple-scene/simple-scene.cabal" \ No newline at end of file + Just "Spear.cabal" \ No newline at end of file diff --git a/Spear/GLSL.hs b/Spear/GLSL.hs index 4d81a73..e0e1661 100644 --- a/Spear/GLSL.hs +++ b/Spear/GLSL.hs @@ -1,20 +1,712 @@ module Spear.GLSL ( - module Spear.GLSL.Buffer -, module Spear.GLSL.Error -, module Spear.GLSL.Management -, module Spear.GLSL.Texture -, module Spear.GLSL.Uniform -, module Spear.GLSL.VAO -, module Graphics.Rendering.OpenGL.Raw.Core31 + -- * General Management + GLSLShader +, GLSLProgram +, ShaderType(..) + -- ** Programs +, newProgram +, releaseProgram +, linkProgram +, useProgram +, withGLSLProgram + -- ** Shaders +, attachShader +, detachShader +, loadShader +, newShader +, releaseShader + -- *** Source loading +, loadSource +, shaderSource +, readSource +, compile + -- ** Locations +, attribLocation +, fragLocation +, uniformLocation + -- ** Uniforms +, uniformVec3 +, uniformVec4 +, uniformMat3 +, uniformMat4 +, uniformfl +, uniformil + -- ** Helper functions +, ($=) +, Data.StateVar.get + + -- * VAOs +, VAO + -- ** Creation and destruction +, newVAO +, releaseVAO + -- ** Manipulation +, bindVAO +, enableVAOAttrib +, attribVAOPointer + -- ** Rendering +, drawArrays +, drawElements + + -- * Buffers +, GLBuffer +, TargetBuffer(..) +, BufferUsage(..) + -- ** Creation and destruction +, newBuffer +, releaseBuffer + -- ** Manipulation +, bindBuffer +, bufferData +, withGLBuffer + + -- * Textures +, Texture +, SettableStateVar +, GLenum +, ($) + -- ** Creation and destruction +, newTexture +, releaseTexture + -- ** Manipulation +, bindTexture +, loadTextureData +, texParami +, texParamf +, activeTexture + + -- * Error Handling +, getGLError +, printGLError +, assertGL ) where -import Spear.GLSL.Buffer -import Spear.GLSL.Error -import Spear.GLSL.Management -import Spear.GLSL.Texture -import Spear.GLSL.Uniform -import Spear.GLSL.VAO +import Spear.Math.Matrix3 (Matrix3) +import Spear.Math.Matrix4 (Matrix4) +import Spear.Math.Vector3 as V3 +import Spear.Math.Vector4 as V4 +import Spear.Setup + +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 + } + + +-- | A GLSL program handle. +data GLSLProgram = GLSLProgram + { getProgram :: GLuint + , getProgramKey :: Resource + } + + +-- | 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] -> Setup GLSLProgram +newProgram shaders = do + h <- setupIO glCreateProgram + when (h == 0) $ setupError "glCreateProgram failed" + rkey <- register $ deleteProgram h + let program = GLSLProgram h rkey + + mapM_ (setupIO . attachShader program) shaders + linkProgram program + + return program + + +-- | Release the program. +releaseProgram :: GLSLProgram -> Setup () +releaseProgram = release . getProgramKey + + +-- | Delete the program. +deleteProgram :: GLuint -> IO () +--deleteProgram = glDeleteProgram +deleteProgram prog = do + putStrLn $ "Deleting shader program " ++ show prog + glDeleteProgram prog + + +-- | Link the program. +linkProgram :: GLSLProgram -> Setup () +linkProgram prog = do + let h = getProgram prog + err <- setupIO $ 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 () + _ -> setupError 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 -> Setup GLSLShader +loadShader file shaderType = do + shader <- newShader shaderType + loadSource file shader + compile file shader + return shader + + +-- | Create a new shader. +newShader :: ShaderType -> Setup GLSLShader +newShader shaderType = do + h <- setupIO $ glCreateShader (toGLShader shaderType) + case h of + 0 -> setupError "glCreateShader failed" + _ -> do + rkey <- register $ deleteShader h + return $ GLSLShader h rkey + + +-- | Release the shader. +releaseShader :: GLSLShader -> Setup () +releaseShader = release . getShaderKey + + +-- | 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 -> Setup () +loadSource file h = do + exists <- setupIO $ doesFileExist file + case exists of + False -> setupError "the specified shader file does not exist" + True -> setupIO $ 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 -> Setup () +compile file shader = do + let h = getShader shader + + -- Compile + setupIO $ glCompileShader h + + -- Verify status + err <- setupIO $ 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 () + _ -> setupError $ "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 3D vector. +uniformVec3 :: GLint -> Vector3 -> IO () +uniformVec3 loc v = glUniform3f loc x' y' z' + where x' = unsafeCoerce $ V3.x v + y' = unsafeCoerce $ V3.y v + z' = unsafeCoerce $ V3.z v + + +-- | Load a 4D vector. +uniformVec4 :: GLint -> Vector4 -> IO () +uniformVec4 loc v = glUniform4f loc x' y' z' w' + where x' = unsafeCoerce $ V4.x v + y' = unsafeCoerce $ V4.y v + z' = unsafeCoerce $ V4.z v + w' = unsafeCoerce $ V4.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 Eq VAO where + vao1 == vao2 = getVAO vao1 == getVAO vao2 + + +instance Ord VAO where + vao1 < vao2 = getVAO vao1 < getVAO vao2 + + +-- | Create a new vao. +newVAO :: Setup VAO +newVAO = do + h <- setupIO . alloca $ \ptr -> do + glGenVertexArrays 1 ptr + peek ptr + + rkey <- register $ deleteVAO h + return $ VAO h rkey + + +-- | Release the vao. +releaseVAO :: VAO -> Setup () +releaseVAO = release . vaoKey + + +-- | 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 -> IO () +enableVAOAttrib = glEnableVertexAttribArray + + +-- | Bind the bound buffer to the given point. +attribVAOPointer :: GLuint -> GLint -> GLenum -> Bool -> GLsizei -> Int -> IO () +attribVAOPointer idx ncomp dattype normalise stride off = + glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off) + + +-- | Draw the bound vao. +drawArrays :: GLenum -> Int -> Int -> IO () +drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count) + + +-- | Draw the bound vao, indexed mode. +drawElements :: GLenum -> Int -> GLenum -> Ptr a -> IO () +drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs + + + + + + +-- +-- BUFFER +-- + + +-- | An OpenGL buffer. +data GLBuffer = GLBuffer + { getBuffer :: GLuint + , rkey :: Resource + } + + +-- | 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 :: Setup GLBuffer +newBuffer = do + h <- setupIO . alloca $ \ptr -> do + glGenBuffers 1 ptr + peek ptr + + rkey <- register $ deleteBuffer h + return $ GLBuffer h rkey + + +-- | Release the buffer. +releaseBuffer :: GLBuffer -> Setup () +releaseBuffer = release . 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 -> Ptr a -> BufferUsage -> IO () +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 +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 + + +-- | Create a new texture. +newTexture :: Setup Texture +newTexture = do + tex <- setupIO . alloca $ \ptr -> do + glGenTextures 1 ptr + peek ptr + + rkey <- register $ deleteTexture tex + return $ Texture tex rkey + + +-- | Release the texture. +releaseTexture :: Texture -> Setup () +releaseTexture = release . texKey + + +-- | Delete the texture. +deleteTexture :: GLuint -> IO () +--deleteTexture tex = with tex $ glDeleteTextures 1 +deleteTexture tex = do + putStrLn $ "Releasing texture " ++ show tex + with tex $ glDeleteTextures 1 + + +-- | 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 :: Setup a -> String -> Setup a +assertGL action err = do + result <- action + status <- setupIO getGLError + case status of + Just str -> setupError $ "OpenGL error raised: " ++ err ++ "; " ++ str + Nothing -> return result diff --git a/Spear/GLSL/Buffer.hs b/Spear/GLSL/Buffer.hs deleted file mode 100644 index 0f43d66..0000000 --- a/Spear/GLSL/Buffer.hs +++ /dev/null @@ -1,111 +0,0 @@ -module Spear.GLSL.Buffer -( - GLBuffer -, TargetBuffer(..) -, BufferUsage(..) -, newBuffer -, releaseBuffer -, bindBuffer -, bufferData -, withGLBuffer -) -where - - -import Spear.Setup -import Spear.GLSL.Management - -import Graphics.Rendering.OpenGL.Raw.Core31 -import Control.Monad.Trans.Class (lift) -import Data.StateVar -import Foreign.Ptr -import Foreign.Marshal.Utils as Foreign (with) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Storable (peek) -import Unsafe.Coerce - - --- | Represents an OpenGL buffer. -data GLBuffer = GLBuffer - { getBuffer :: GLuint - , rkey :: Resource - } - - --- | Represents a 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 - - --- | Represents a type of 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 'GLBuffer'. -newBuffer :: Setup GLBuffer -newBuffer = do - h <- setupIO . alloca $ \ptr -> do - glGenBuffers 1 ptr - peek ptr - - rkey <- register $ deleteBuffer h - return $ GLBuffer h rkey - - --- | Release the given 'GLBuffer'. -releaseBuffer :: GLBuffer -> Setup () -releaseBuffer = release . rkey - - --- | Delete the given 'GLBuffer'. -deleteBuffer :: GLuint -> IO () -deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1 - - --- | Bind the given 'GLBuffer'. -bindBuffer :: GLBuffer -> TargetBuffer -> IO () -bindBuffer buf target = glBindBuffer (fromTarget target) $ getBuffer buf - - --- | Set buffer data. -bufferData :: TargetBuffer -> Int -> Ptr a -> BufferUsage -> IO () -bufferData target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage) - - --- | Apply the given function the 'GLBuffer''s id. -withGLBuffer :: GLBuffer -> (GLuint -> a) -> a -withGLBuffer buf f = f $ getBuffer buf - diff --git a/Spear/GLSL/Error.hs b/Spear/GLSL/Error.hs deleted file mode 100644 index 7865996..0000000 --- a/Spear/GLSL/Error.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Spear.GLSL.Error -( - getGLError -, printGLError -, assertGL -) -where - - -import Spear.Setup - -import Graphics.Rendering.OpenGL.Raw.Core31 -import System.IO (hPutStrLn, stderr) - - --- | 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 and the OpenGL error. -assertGL :: Setup a -> String -> Setup a -assertGL action err = do - result <- action - status <- setupIO getGLError - case status of - Just str -> setupError $ "OpenGL error raised: " ++ err ++ "; " ++ str - Nothing -> return result diff --git a/Spear/GLSL/Management.hs b/Spear/GLSL/Management.hs deleted file mode 100644 index 81cf45f..0000000 --- a/Spear/GLSL/Management.hs +++ /dev/null @@ -1,297 +0,0 @@ -module Spear.GLSL.Management -( - -- * Data types - GLSLShader -, GLSLProgram -, ShaderType(..) - -- * Program manipulation -, newProgram -, releaseProgram -, linkProgram -, useProgram -, withGLSLProgram - -- * Shader manipulation -, attachShader -, detachShader -, loadShader -, newShader -, releaseShader - -- ** Source loading -, loadSource -, shaderSource -, readSource -, compile - -- * Location -, attribLocation -, fragLocation -, uniformLocation - -- * Helper functions -, ($=) -, Data.StateVar.get -) -where - - -import Spear.Setup - -import Control.Monad ((<=<), forM) -import Control.Monad.Trans.State as State -import Control.Monad.Trans.Error -import Control.Monad.Trans.Class -import Control.Monad (mapM_, when) -import qualified Data.ByteString.Char8 as B -import Data.StateVar -import Foreign.Ptr -import Foreign.Storable -import Foreign.C.String -import Foreign.Marshal.Alloc (alloca) -import Foreign.Marshal.Array (withArray) -import Graphics.Rendering.OpenGL.Raw.Core31 -import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory) -import Unsafe.Coerce - - --- | Represents a GLSL shader handle. -data GLSLShader = GLSLShader - { getShader :: GLuint - , getShaderKey :: Resource - } - - --- | Represents a GLSL program handle. -data GLSLProgram = GLSLProgram - { getProgram :: GLuint - , getProgramKey :: Resource - } - - --- | Encodes several 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 GLSLProgram'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 'GLSLProgram'. -newProgram :: [GLSLShader] -> Setup GLSLProgram -newProgram shaders = do - h <- setupIO glCreateProgram - when (h == 0) $ setupError "glCreateProgram failed" - rkey <- register $ deleteProgram h - let program = GLSLProgram h rkey - - mapM_ (setupIO . attachShader program) shaders - linkProgram program - - return program - - --- | Release the given 'GLSLProgram'. -releaseProgram :: GLSLProgram -> Setup () -releaseProgram = release . getProgramKey - - --- | Delete the given 'GLSLProgram'. -deleteProgram :: GLuint -> IO () ---deleteProgram = glDeleteProgram -deleteProgram prog = do - putStrLn $ "Deleting shader program " ++ show prog - glDeleteProgram prog - - --- | Link the given GLSL program. -linkProgram :: GLSLProgram -> Setup () -linkProgram prog = do - let h = getProgram prog - err <- setupIO $ 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 () - _ -> setupError err - - --- | Use the given GLSL program. -useProgram :: GLSLProgram -> IO () -useProgram prog = glUseProgram $ getProgram prog - - --- | Attach the given GLSL shader to the given GLSL program. -attachShader :: GLSLProgram -> GLSLShader -> IO () -attachShader prog shader = glAttachShader (getProgram prog) (getShader shader) - - --- | Detach the given GLSL shader from the given GLSL 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 -> Setup GLSLShader -loadShader file shaderType = do - shader <- newShader shaderType - loadSource file shader - compile file shader - return shader - - --- | Create a new shader. -newShader :: ShaderType -> Setup GLSLShader -newShader shaderType = do - h <- setupIO $ glCreateShader (toGLShader shaderType) - case h of - 0 -> setupError "glCreateShader failed" - _ -> do - rkey <- register $ deleteShader h - return $ GLSLShader h rkey - - --- | Release the given 'GLSLShader'. -releaseShader :: GLSLShader -> Setup () -releaseShader = release . getShaderKey - - --- | Free the given 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 given shader. -loadSource :: FilePath -> GLSLShader -> Setup () -loadSource file h = do - exists <- setupIO $ doesFileExist file - case exists of - False -> setupError "the specified shader file does not exist" - True -> setupIO $ do - code <- readSource file - withCString code $ shaderSource h - - --- | Load the given shader source into the given shader. -shaderSource :: GLSLShader -> CString -> IO () -shaderSource shader str = - let ptr = unsafeCoerce str - in withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr - - --- | Compile the given shader. -compile :: FilePath -> GLSLShader -> Setup () -compile file shader = do - let h = getShader shader - - -- Compile - setupIO $ glCompileShader h - - -- Verify status - err <- setupIO $ 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 () - _ -> setupError $ "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 - diff --git a/Spear/GLSL/Texture.hs b/Spear/GLSL/Texture.hs deleted file mode 100644 index 8d361a1..0000000 --- a/Spear/GLSL/Texture.hs +++ /dev/null @@ -1,110 +0,0 @@ -module Spear.GLSL.Texture -( - Texture -, SettableStateVar -, GLenum -, ($) - -- * Creation and destruction -, newTexture -, releaseTexture - -- * Manipulation -, bindTexture -, loadTextureData -, texParami -, texParamf -, activeTexture -) -where - - -import Spear.Setup - -import Data.StateVar -import Foreign.Marshal.Alloc (alloca) -import Foreign.Marshal.Utils (with) -import Foreign.Ptr -import Foreign.Storable (peek) -import Graphics.Rendering.OpenGL.Raw.Core31 -import Unsafe.Coerce (unsafeCoerce) - - --- | Represents a texture resource. -data Texture = Texture - { getTex :: GLuint - , rkey :: Resource - } - - -instance Eq Texture where - t1 == t2 = getTex t1 == getTex t2 - - -instance Ord Texture where - t1 < t2 = getTex t1 < getTex t2 - - --- | Create a new 'Texture'. -newTexture :: Setup Texture -newTexture = do - tex <- setupIO . alloca $ \ptr -> do - glGenTextures 1 ptr - peek ptr - - rkey <- register $ deleteTexture tex - return $ Texture tex rkey - - --- | Release the given 'Texture'. -releaseTexture :: Texture -> Setup () -releaseTexture = release . rkey - - --- | Delete the given 'Texture'. -deleteTexture :: GLuint -> IO () ---deleteTexture tex = with tex $ glDeleteTextures 1 -deleteTexture tex = do - putStrLn $ "Releasing texture " ++ show tex - with tex $ glDeleteTextures 1 - - --- | Bind the given 'Texture'. -bindTexture :: Texture -> IO () -bindTexture = glBindTexture gl_TEXTURE_2D . getTex - - --- | Load data onto the bound 'Texture'. -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 given 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 given 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 diff --git a/Spear/GLSL/Uniform.hs b/Spear/GLSL/Uniform.hs deleted file mode 100644 index f186333..0000000 --- a/Spear/GLSL/Uniform.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Spear.GLSL.Uniform -( - uniformVec3 -, uniformVec4 -, uniformMat3 -, uniformMat4 -, uniformfl -, uniformil -) -where - - -import Spear.GLSL.Management -import Spear.Math.Matrix3 (Matrix3) -import Spear.Math.Matrix4 (Matrix4) -import Spear.Math.Vector3 as V3 -import Spear.Math.Vector4 as V4 - -import Foreign.Marshal.Array (withArray) -import Foreign.Marshal.Utils -import Graphics.Rendering.OpenGL.Raw.Core31 -import Unsafe.Coerce - - -uniformVec3 :: GLint -> Vector3 -> IO () -uniformVec3 loc v = glUniform3f loc x' y' z' - where x' = unsafeCoerce $ V3.x v - y' = unsafeCoerce $ V3.y v - z' = unsafeCoerce $ V3.z v - - -uniformVec4 :: GLint -> Vector4 -> IO () -uniformVec4 loc v = glUniform4f loc x' y' z' w' - where x' = unsafeCoerce $ V4.x v - y' = unsafeCoerce $ V4.y v - z' = unsafeCoerce $ V4.z v - w' = unsafeCoerce $ V4.w v - - -uniformMat3 :: GLint -> Matrix3 -> IO () -uniformMat3 loc mat = - with mat $ \ptrMat -> - glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) - - -uniformMat4 :: GLint -> Matrix4 -> IO () -uniformMat4 loc mat = - with mat $ \ptrMat -> - glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) - - -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 - - -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 diff --git a/Spear/GLSL/VAO.hs b/Spear/GLSL/VAO.hs deleted file mode 100644 index f121636..0000000 --- a/Spear/GLSL/VAO.hs +++ /dev/null @@ -1,88 +0,0 @@ -module Spear.GLSL.VAO -( - VAO - -- * Creation and destruction -, newVAO -, releaseVAO - -- * Manipulation -, bindVAO -, enableVAOAttrib -, attribVAOPointer - -- * Rendering -, drawArrays -, drawElements -) -where - - -import Spear.Setup -import Control.Monad.Trans.Class (lift) -import Foreign.Marshal.Utils as Foreign (with) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Storable (peek) -import Foreign.Ptr -import Unsafe.Coerce -import Graphics.Rendering.OpenGL.Raw.Core31 - - --- | Represents a vertex array object. -data VAO = VAO - { getVAO :: GLuint - , rkey :: Resource - } - - -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 :: Setup VAO -newVAO = do - h <- setupIO . alloca $ \ptr -> do - glGenVertexArrays 1 ptr - peek ptr - - rkey <- register $ deleteVAO h - return $ VAO h rkey - - --- | Release the given 'VAO'. -releaseVAO :: VAO -> Setup () -releaseVAO = release . rkey - - --- | Delete the given 'VAO'. -deleteVAO :: GLuint -> IO () -deleteVAO vao = Foreign.with vao $ glDeleteVertexArrays 1 - - --- | Bind the given 'VAO'. -bindVAO :: VAO -> IO () -bindVAO = glBindVertexArray . getVAO - - --- | Enable the given vertex attribute of the bound 'VAO'. -enableVAOAttrib :: GLuint -> IO () -enableVAOAttrib = glEnableVertexAttribArray - - --- | Bind the bound buffer to the given point. -attribVAOPointer :: GLuint -> GLint -> GLenum -> Bool -> GLsizei -> Int -> IO () -attribVAOPointer idx ncomp dattype normalise stride off = - glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off) - - --- | Draw the bound 'VAO'. -drawArrays :: GLenum -> Int -> Int -> IO () -drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count) - - --- | Draw the bound 'VAO', indexed mode. -drawElements :: GLenum -> Int -> GLenum -> Ptr a -> IO () -drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs - diff --git a/Spear/Render/Program.hs b/Spear/Render/Program.hs index 9755aa3..ab2a548 100644 --- a/Spear/Render/Program.hs +++ b/Spear/Render/Program.hs @@ -12,7 +12,7 @@ module Spear.Render.Program where -import Spear.GLSL.Management (GLSLProgram) +import Spear.GLSL (GLSLProgram) import Graphics.Rendering.OpenGL.Raw.Core31 diff --git a/Spear/Render/Texture.hs b/Spear/Render/Texture.hs index 59e7797..3311ce6 100644 --- a/Spear/Render/Texture.hs +++ b/Spear/Render/Texture.hs @@ -7,7 +7,7 @@ where import Spear.Setup import Spear.Assets.Image -import Spear.GLSL.Texture +import Spear.GLSL import Data.StateVar (($=)) import Graphics.Rendering.OpenGL.Raw.Core31 diff --git a/Spear/Scene/GameObject.hs b/Spear/Scene/GameObject.hs index 89db341..cfc825d 100644 --- a/Spear/Scene/GameObject.hs +++ b/Spear/Scene/GameObject.hs @@ -25,8 +25,7 @@ where import Spear.Collision.Collision import Spear.Collision.Collisioner as Col -import Spear.GLSL.Management -import Spear.GLSL.Uniform +import Spear.GLSL import Spear.Math.AABB import qualified Spear.Math.Camera as Cam import qualified Spear.Math.Matrix3 as M3 -- cgit v1.2.3