diff options
-rw-r--r-- | Spear.cabal | 29 | ||||
-rw-r--r-- | Spear.lkshs | 10 | ||||
-rw-r--r-- | Spear.lkshw | 6 | ||||
-rw-r--r-- | Spear/GLSL.hs | 718 | ||||
-rw-r--r-- | Spear/GLSL/Buffer.hs | 111 | ||||
-rw-r--r-- | Spear/GLSL/Error.hs | 45 | ||||
-rw-r--r-- | Spear/GLSL/Management.hs | 297 | ||||
-rw-r--r-- | Spear/GLSL/Texture.hs | 110 | ||||
-rw-r--r-- | Spear/GLSL/Uniform.hs | 67 | ||||
-rw-r--r-- | Spear/GLSL/VAO.hs | 88 | ||||
-rw-r--r-- | Spear/Render/Program.hs | 2 | ||||
-rw-r--r-- | Spear/Render/Texture.hs | 2 | ||||
-rw-r--r-- | Spear/Scene/GameObject.hs | 3 |
13 files changed, 730 insertions, 758 deletions
diff --git a/Spear.cabal b/Spear.cabal index 01a2b23..1f32616 100644 --- a/Spear.cabal +++ b/Spear.cabal | |||
@@ -21,21 +21,20 @@ library | |||
21 | Spear.Assets.Image Spear.Assets.Model Spear.Collision | 21 | Spear.Assets.Image Spear.Assets.Model Spear.Collision |
22 | Spear.Math.AABB Spear.Collision.Collision | 22 | Spear.Math.AABB Spear.Collision.Collision |
23 | Spear.Collision.Collisioner Spear.Math.Circle Spear.Math.Triangle | 23 | Spear.Collision.Collisioner Spear.Math.Circle Spear.Math.Triangle |
24 | Spear.Collision.Types Spear.Game Spear.GLSL Spear.GLSL.Buffer | 24 | Spear.Collision.Types Spear.Game Spear.GLSL Spear.Math.Camera |
25 | Spear.GLSL.Error Spear.GLSL.Management Spear.GLSL.Texture | 25 | Spear.Math.Entity |
26 | Spear.GLSL.Uniform Spear.GLSL.VAO Spear.Math.Camera | 26 | Spear.Math.Matrix3 Spear.Math.Matrix4 Spear.Math.MatrixUtils |
27 | Spear.Math.Entity Spear.Math.Matrix3 Spear.Math.Matrix4 | 27 | Spear.Math.Plane Spear.Math.Quaternion Spear.Math.Vector3 |
28 | Spear.Math.MatrixUtils Spear.Math.Plane Spear.Math.Quaternion | 28 | Spear.Math.Vector4 Spear.Physics Spear.Physics.Rigid |
29 | Spear.Math.Vector3 Spear.Math.Vector4 | 29 | Spear.Render.AnimatedModel Spear.Render.Material Spear.Render.Model |
30 | Spear.Physics Spear.Physics.Rigid Spear.Render.AnimatedModel | 30 | Spear.Render.Program Spear.Render.Renderable |
31 | Spear.Render.Material Spear.Render.Model Spear.Render.Program | 31 | Spear.Render.StaticModel Spear.Render.Texture Spear.Scene.Graph |
32 | Spear.Render.Renderable Spear.Render.StaticModel | 32 | Spear.Scene.Light Spear.Scene.Loader Spear.Scene.Scene |
33 | Spear.Render.Texture Spear.Scene.Graph Spear.Scene.Light | 33 | Spear.Scene.SceneResources Spear.Setup Spear.Sys.Timer |
34 | Spear.Scene.Loader Spear.Scene.Scene Spear.Scene.SceneResources | 34 | Spear.Sys.Store Spear.Sys.Store.ID Spear.Updatable |
35 | Spear.Setup Spear.Sys.Timer Spear.Sys.Store Spear.Sys.Store.ID | 35 | Spear.Math.Vector2 Spear.Math.Quad Spear.Math.Ray |
36 | Spear.Updatable Spear.Math.Vector2 Spear.Math.Quad Spear.Math.Ray | 36 | Spear.Math.Segment Spear.Math.Utils Spear.Math.Spatial2 |
37 | Spear.Math.Segment Spear.Math.Utils | 37 | Spear.Math.Spatial3 |
38 | Spear.Math.Spatial2 Spear.Math.Spatial3 | ||
39 | exposed: True | 38 | exposed: True |
40 | buildable: True | 39 | buildable: True |
41 | build-tools: hsc2hs -any | 40 | 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 @@ | |||
1 | Version of session file format: | 1 | Version of session file format: |
2 | 1 | 2 | 1 |
3 | Time of storage: | 3 | Time of storage: |
4 | "Thu Aug 30 17:27:24 CEST 2012" | 4 | "Thu Aug 30 18:49:02 CEST 2012" |
5 | 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 | 5 | 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 |
6 | 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])] | 6 | 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])] |
7 | Window size: (1820,939) | 7 | Window size: (1820,939) |
8 | Completion size: | 8 | Completion size: |
9 | (750,399) | 9 | (750,399) |
10 | Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" | 10 | Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" |
11 | Active pane: Just "Factory.hs" | 11 | Active pane: Just "main.hs" |
12 | Toolbar visible: | 12 | Toolbar visible: |
13 | True | 13 | True |
14 | 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}) | 14 | 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}) |
15 | Recently opened files: | 15 | Recently opened files: |
16 | ["/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"] | 16 | ["/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"] |
17 | Recently opened workspaces: | 17 | Recently opened workspaces: |
18 | ["/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 | 18 | ["/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 @@ | |||
1 | Version of workspace file format: | 1 | Version of workspace file format: |
2 | 1 | 2 | 1 |
3 | Time of storage: | 3 | Time of storage: |
4 | "Thu Aug 30 16:58:13 CEST 2012" | 4 | "Thu Aug 30 18:50:08 CEST 2012" |
5 | Name of the workspace: | 5 | Name of the workspace: |
6 | "Spear" | 6 | "Spear" |
7 | File paths of contained packages: | 7 | File paths of contained packages: |
8 | ["demos/simple-scene/simple-scene.cabal","Spear.cabal"] | 8 | ["Spear.cabal"] |
9 | Maybe file path of an active package: | 9 | Maybe file path of an active package: |
10 | Just "demos/simple-scene/simple-scene.cabal" \ No newline at end of file | 10 | 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 @@ | |||
1 | module Spear.GLSL | 1 | module Spear.GLSL |
2 | ( | 2 | ( |
3 | module Spear.GLSL.Buffer | 3 | -- * General Management |
4 | , module Spear.GLSL.Error | 4 | GLSLShader |
5 | , module Spear.GLSL.Management | 5 | , GLSLProgram |
6 | , module Spear.GLSL.Texture | 6 | , ShaderType(..) |
7 | , module Spear.GLSL.Uniform | 7 | -- ** Programs |
8 | , module Spear.GLSL.VAO | 8 | , newProgram |
9 | , module Graphics.Rendering.OpenGL.Raw.Core31 | 9 | , releaseProgram |
10 | , linkProgram | ||
11 | , useProgram | ||
12 | , withGLSLProgram | ||
13 | -- ** Shaders | ||
14 | , attachShader | ||
15 | , detachShader | ||
16 | , loadShader | ||
17 | , newShader | ||
18 | , releaseShader | ||
19 | -- *** Source loading | ||
20 | , loadSource | ||
21 | , shaderSource | ||
22 | , readSource | ||
23 | , compile | ||
24 | -- ** Locations | ||
25 | , attribLocation | ||
26 | , fragLocation | ||
27 | , uniformLocation | ||
28 | -- ** Uniforms | ||
29 | , uniformVec3 | ||
30 | , uniformVec4 | ||
31 | , uniformMat3 | ||
32 | , uniformMat4 | ||
33 | , uniformfl | ||
34 | , uniformil | ||
35 | -- ** Helper functions | ||
36 | , ($=) | ||
37 | , Data.StateVar.get | ||
38 | |||
39 | -- * VAOs | ||
40 | , VAO | ||
41 | -- ** Creation and destruction | ||
42 | , newVAO | ||
43 | , releaseVAO | ||
44 | -- ** Manipulation | ||
45 | , bindVAO | ||
46 | , enableVAOAttrib | ||
47 | , attribVAOPointer | ||
48 | -- ** Rendering | ||
49 | , drawArrays | ||
50 | , drawElements | ||
51 | |||
52 | -- * Buffers | ||
53 | , GLBuffer | ||
54 | , TargetBuffer(..) | ||
55 | , BufferUsage(..) | ||
56 | -- ** Creation and destruction | ||
57 | , newBuffer | ||
58 | , releaseBuffer | ||
59 | -- ** Manipulation | ||
60 | , bindBuffer | ||
61 | , bufferData | ||
62 | , withGLBuffer | ||
63 | |||
64 | -- * Textures | ||
65 | , Texture | ||
66 | , SettableStateVar | ||
67 | , GLenum | ||
68 | , ($) | ||
69 | -- ** Creation and destruction | ||
70 | , newTexture | ||
71 | , releaseTexture | ||
72 | -- ** Manipulation | ||
73 | , bindTexture | ||
74 | , loadTextureData | ||
75 | , texParami | ||
76 | , texParamf | ||
77 | , activeTexture | ||
78 | |||
79 | -- * Error Handling | ||
80 | , getGLError | ||
81 | , printGLError | ||
82 | , assertGL | ||
10 | ) | 83 | ) |
11 | where | 84 | where |
12 | 85 | ||
13 | 86 | ||
14 | import Spear.GLSL.Buffer | 87 | import Spear.Math.Matrix3 (Matrix3) |
15 | import Spear.GLSL.Error | 88 | import Spear.Math.Matrix4 (Matrix4) |
16 | import Spear.GLSL.Management | 89 | import Spear.Math.Vector3 as V3 |
17 | import Spear.GLSL.Texture | 90 | import Spear.Math.Vector4 as V4 |
18 | import Spear.GLSL.Uniform | 91 | import Spear.Setup |
19 | import Spear.GLSL.VAO | 92 | |
93 | import Control.Monad | ||
94 | import Control.Monad.Trans.Class | ||
95 | import Control.Monad.Trans.Error | ||
96 | import Control.Monad.Trans.State as State | ||
97 | import qualified Data.ByteString.Char8 as B | ||
98 | import Data.StateVar | ||
99 | import Foreign.C.String | ||
100 | import Foreign.Ptr | ||
101 | import Foreign.Storable | ||
102 | import Foreign.Marshal.Utils as Foreign (with) | ||
103 | import Foreign.Marshal.Alloc (alloca) | ||
104 | import Foreign.Marshal.Array (withArray) | ||
105 | import Foreign.Storable (peek) | ||
20 | import Graphics.Rendering.OpenGL.Raw.Core31 | 106 | import Graphics.Rendering.OpenGL.Raw.Core31 |
107 | import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory) | ||
108 | import System.IO (hPutStrLn, stderr) | ||
109 | import Unsafe.Coerce | ||
110 | |||
111 | |||
112 | -- | ||
113 | -- MANAGEMENT | ||
114 | -- | ||
115 | |||
116 | |||
117 | -- | A GLSL shader handle. | ||
118 | data GLSLShader = GLSLShader | ||
119 | { getShader :: GLuint | ||
120 | , getShaderKey :: Resource | ||
121 | } | ||
122 | |||
123 | |||
124 | -- | A GLSL program handle. | ||
125 | data GLSLProgram = GLSLProgram | ||
126 | { getProgram :: GLuint | ||
127 | , getProgramKey :: Resource | ||
128 | } | ||
129 | |||
130 | |||
131 | -- | Supported shader types. | ||
132 | data ShaderType = VertexShader | FragmentShader deriving (Eq, Show) | ||
133 | |||
134 | |||
135 | toGLShader :: ShaderType -> GLenum | ||
136 | toGLShader VertexShader = gl_VERTEX_SHADER | ||
137 | toGLShader FragmentShader = gl_FRAGMENT_SHADER | ||
138 | |||
139 | |||
140 | -- | Apply the given function to the program's id. | ||
141 | withGLSLProgram :: GLSLProgram -> (GLuint -> a) -> a | ||
142 | withGLSLProgram prog f = f $ getProgram prog | ||
143 | |||
144 | |||
145 | -- | Get the location of the given uniform variable within the given program. | ||
146 | uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint | ||
147 | uniformLocation prog var = makeGettableStateVar get | ||
148 | where | ||
149 | get = withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str) | ||
150 | |||
151 | |||
152 | -- | Get or set the location of the given variable to a fragment shader colour number. | ||
153 | fragLocation :: GLSLProgram -> String -> StateVar GLint | ||
154 | fragLocation prog var = makeStateVar get set | ||
155 | where | ||
156 | get = withCString var $ \str -> glGetFragDataLocation (getProgram prog) (unsafeCoerce str) | ||
157 | set idx = withCString var $ \str -> | ||
158 | glBindFragDataLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str) | ||
159 | |||
160 | |||
161 | -- | Get or set the location of the given attribute within the given program. | ||
162 | attribLocation :: GLSLProgram -> String -> StateVar GLint | ||
163 | attribLocation prog var = makeStateVar get set | ||
164 | where | ||
165 | get = withCString var $ \str -> glGetAttribLocation (getProgram prog) (unsafeCoerce str) | ||
166 | set idx = withCString var $ \str -> | ||
167 | glBindAttribLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str) | ||
168 | |||
169 | |||
170 | -- | Create a new program. | ||
171 | newProgram :: [GLSLShader] -> Setup GLSLProgram | ||
172 | newProgram shaders = do | ||
173 | h <- setupIO glCreateProgram | ||
174 | when (h == 0) $ setupError "glCreateProgram failed" | ||
175 | rkey <- register $ deleteProgram h | ||
176 | let program = GLSLProgram h rkey | ||
177 | |||
178 | mapM_ (setupIO . attachShader program) shaders | ||
179 | linkProgram program | ||
180 | |||
181 | return program | ||
182 | |||
183 | |||
184 | -- | Release the program. | ||
185 | releaseProgram :: GLSLProgram -> Setup () | ||
186 | releaseProgram = release . getProgramKey | ||
187 | |||
188 | |||
189 | -- | Delete the program. | ||
190 | deleteProgram :: GLuint -> IO () | ||
191 | --deleteProgram = glDeleteProgram | ||
192 | deleteProgram prog = do | ||
193 | putStrLn $ "Deleting shader program " ++ show prog | ||
194 | glDeleteProgram prog | ||
195 | |||
196 | |||
197 | -- | Link the program. | ||
198 | linkProgram :: GLSLProgram -> Setup () | ||
199 | linkProgram prog = do | ||
200 | let h = getProgram prog | ||
201 | err <- setupIO $ do | ||
202 | glLinkProgram h | ||
203 | alloca $ \statptr -> do | ||
204 | glGetProgramiv h gl_LINK_STATUS statptr | ||
205 | status <- peek statptr | ||
206 | case status of | ||
207 | 0 -> getStatus glGetProgramiv glGetProgramInfoLog h | ||
208 | _ -> return "" | ||
209 | |||
210 | case length err of | ||
211 | 0 -> return () | ||
212 | _ -> setupError err | ||
213 | |||
214 | |||
215 | -- | Use the program. | ||
216 | useProgram :: GLSLProgram -> IO () | ||
217 | useProgram prog = glUseProgram $ getProgram prog | ||
218 | |||
219 | |||
220 | -- | Attach the given shader to the given program. | ||
221 | attachShader :: GLSLProgram -> GLSLShader -> IO () | ||
222 | attachShader prog shader = glAttachShader (getProgram prog) (getShader shader) | ||
223 | |||
224 | |||
225 | -- | Detach the given GLSL from the given program. | ||
226 | detachShader :: GLSLProgram -> GLSLShader -> IO () | ||
227 | detachShader prog shader = glDetachShader (getProgram prog) (getShader shader) | ||
228 | |||
229 | |||
230 | -- | Load a shader from the file specified by the given string. | ||
231 | -- | ||
232 | -- This function creates a new shader. To load source code into an existing shader, | ||
233 | -- see 'loadSource', 'shaderSource' and 'readSource'. | ||
234 | loadShader :: FilePath -> ShaderType -> Setup GLSLShader | ||
235 | loadShader file shaderType = do | ||
236 | shader <- newShader shaderType | ||
237 | loadSource file shader | ||
238 | compile file shader | ||
239 | return shader | ||
240 | |||
241 | |||
242 | -- | Create a new shader. | ||
243 | newShader :: ShaderType -> Setup GLSLShader | ||
244 | newShader shaderType = do | ||
245 | h <- setupIO $ glCreateShader (toGLShader shaderType) | ||
246 | case h of | ||
247 | 0 -> setupError "glCreateShader failed" | ||
248 | _ -> do | ||
249 | rkey <- register $ deleteShader h | ||
250 | return $ GLSLShader h rkey | ||
251 | |||
252 | |||
253 | -- | Release the shader. | ||
254 | releaseShader :: GLSLShader -> Setup () | ||
255 | releaseShader = release . getShaderKey | ||
256 | |||
257 | |||
258 | -- | Free the shader. | ||
259 | deleteShader :: GLuint -> IO () | ||
260 | --deleteShader = glDeleteShader | ||
261 | deleteShader shader = do | ||
262 | putStrLn $ "Deleting shader " ++ show shader | ||
263 | glDeleteShader shader | ||
264 | |||
265 | |||
266 | -- | Load a shader source from the file specified by the given string | ||
267 | -- into the shader. | ||
268 | loadSource :: FilePath -> GLSLShader -> Setup () | ||
269 | loadSource file h = do | ||
270 | exists <- setupIO $ doesFileExist file | ||
271 | case exists of | ||
272 | False -> setupError "the specified shader file does not exist" | ||
273 | True -> setupIO $ do | ||
274 | code <- readSource file | ||
275 | withCString code $ shaderSource h | ||
276 | |||
277 | |||
278 | -- | Load the given shader source into the shader. | ||
279 | shaderSource :: GLSLShader -> CString -> IO () | ||
280 | shaderSource shader str = | ||
281 | let ptr = unsafeCoerce str | ||
282 | in withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr | ||
283 | |||
284 | |||
285 | -- | Compile the shader. | ||
286 | compile :: FilePath -> GLSLShader -> Setup () | ||
287 | compile file shader = do | ||
288 | let h = getShader shader | ||
289 | |||
290 | -- Compile | ||
291 | setupIO $ glCompileShader h | ||
292 | |||
293 | -- Verify status | ||
294 | err <- setupIO $ alloca $ \statusPtr -> do | ||
295 | glGetShaderiv h gl_COMPILE_STATUS statusPtr | ||
296 | result <- peek statusPtr | ||
297 | case result of | ||
298 | 0 -> getStatus glGetShaderiv glGetShaderInfoLog h | ||
299 | _ -> return "" | ||
300 | |||
301 | case length err of | ||
302 | 0 -> return () | ||
303 | _ -> setupError $ "Unable to compile shader " ++ file ++ ":\n" ++ err | ||
304 | |||
305 | |||
306 | type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO () | ||
307 | type LogCall = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO () | ||
308 | |||
309 | |||
310 | getStatus :: StatusCall -> LogCall -> GLuint -> IO String | ||
311 | getStatus getStatus getLog h = do | ||
312 | alloca $ \lenPtr -> do | ||
313 | getStatus h gl_INFO_LOG_LENGTH lenPtr | ||
314 | len <- peek lenPtr | ||
315 | case len of | ||
316 | 0 -> return "" | ||
317 | _ -> withCString (replicate (unsafeCoerce len) '\0') $ getErrorString getLog h (unsafeCoerce len) | ||
318 | |||
319 | |||
320 | getErrorString :: LogCall -> GLuint -> GLsizei -> CString -> IO String | ||
321 | getErrorString getLog h len str = do | ||
322 | let ptr = unsafeCoerce str | ||
323 | getLog h len nullPtr ptr | ||
324 | peekCString str | ||
325 | |||
326 | |||
327 | -- | Load the shader source specified by the given file. | ||
328 | -- | ||
329 | -- This function implements an #include mechanism, so the given file can | ||
330 | -- refer to other files. | ||
331 | readSource :: FilePath -> IO String | ||
332 | readSource = fmap B.unpack . readSource' | ||
333 | |||
334 | |||
335 | readSource' :: FilePath -> IO B.ByteString | ||
336 | readSource' file = do | ||
337 | let includeB = B.pack "#include" | ||
338 | newLineB = B.pack "\n" | ||
339 | isInclude = ((==) includeB) . B.take 8 | ||
340 | clean = B.dropWhile (\c -> c == ' ') | ||
341 | cleanInclude = B.filter (\c -> c /= '"') . B.dropWhile (\c -> c /= ' ') | ||
342 | toLines = B.splitWith (\c -> c == '\n' || c == '\r') | ||
343 | addNewLine s = if (B.last s /= '\n') then B.append s newLineB else s | ||
344 | parse = fmap B.concat . (fmap . fmap $ flip B.append newLineB) . sequence . | ||
345 | fmap (processLine . clean) . toLines | ||
346 | processLine l = | ||
347 | if isInclude l | ||
348 | then readSource' $ B.unpack . clean . cleanInclude $ l | ||
349 | else return l | ||
350 | |||
351 | contents <- B.readFile file | ||
352 | |||
353 | dir <- getCurrentDirectory | ||
354 | let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file | ||
355 | |||
356 | setCurrentDirectory dir' | ||
357 | code <- parse contents | ||
358 | setCurrentDirectory dir | ||
359 | |||
360 | return code | ||
361 | |||
362 | |||
363 | -- | Load a 3D vector. | ||
364 | uniformVec3 :: GLint -> Vector3 -> IO () | ||
365 | uniformVec3 loc v = glUniform3f loc x' y' z' | ||
366 | where x' = unsafeCoerce $ V3.x v | ||
367 | y' = unsafeCoerce $ V3.y v | ||
368 | z' = unsafeCoerce $ V3.z v | ||
369 | |||
370 | |||
371 | -- | Load a 4D vector. | ||
372 | uniformVec4 :: GLint -> Vector4 -> IO () | ||
373 | uniformVec4 loc v = glUniform4f loc x' y' z' w' | ||
374 | where x' = unsafeCoerce $ V4.x v | ||
375 | y' = unsafeCoerce $ V4.y v | ||
376 | z' = unsafeCoerce $ V4.z v | ||
377 | w' = unsafeCoerce $ V4.w v | ||
378 | |||
379 | |||
380 | -- | Load a 3x3 matrix. | ||
381 | uniformMat3 :: GLint -> Matrix3 -> IO () | ||
382 | uniformMat3 loc mat = | ||
383 | with mat $ \ptrMat -> | ||
384 | glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | ||
385 | |||
386 | |||
387 | -- | Load a 4x4 matrix. | ||
388 | uniformMat4 :: GLint -> Matrix4 -> IO () | ||
389 | uniformMat4 loc mat = | ||
390 | with mat $ \ptrMat -> | ||
391 | glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | ||
392 | |||
393 | |||
394 | -- | Load a list of floats. | ||
395 | uniformfl :: GLint -> [GLfloat] -> IO () | ||
396 | uniformfl loc vals = withArray vals $ \ptr -> | ||
397 | case length vals of | ||
398 | 1 -> glUniform1fv loc 1 ptr | ||
399 | 2 -> glUniform2fv loc 1 ptr | ||
400 | 3 -> glUniform3fv loc 1 ptr | ||
401 | 4 -> glUniform4fv loc 1 ptr | ||
402 | |||
403 | |||
404 | -- | Load a list of integers. | ||
405 | uniformil :: GLint -> [GLint] -> IO () | ||
406 | uniformil loc vals = withArray vals $ \ptr -> | ||
407 | case length vals of | ||
408 | 1 -> glUniform1iv loc 1 ptr | ||
409 | 2 -> glUniform2iv loc 1 ptr | ||
410 | 3 -> glUniform3iv loc 1 ptr | ||
411 | 4 -> glUniform4iv loc 1 ptr | ||
412 | |||
413 | |||
414 | |||
415 | |||
416 | |||
417 | |||
418 | -- | ||
419 | -- VAOs | ||
420 | -- | ||
421 | |||
422 | |||
423 | -- | A vertex array object. | ||
424 | data VAO = VAO | ||
425 | { getVAO :: GLuint | ||
426 | , vaoKey :: Resource | ||
427 | } | ||
428 | |||
429 | |||
430 | instance Eq VAO where | ||
431 | vao1 == vao2 = getVAO vao1 == getVAO vao2 | ||
432 | |||
433 | |||
434 | instance Ord VAO where | ||
435 | vao1 < vao2 = getVAO vao1 < getVAO vao2 | ||
436 | |||
437 | |||
438 | -- | Create a new vao. | ||
439 | newVAO :: Setup VAO | ||
440 | newVAO = do | ||
441 | h <- setupIO . alloca $ \ptr -> do | ||
442 | glGenVertexArrays 1 ptr | ||
443 | peek ptr | ||
444 | |||
445 | rkey <- register $ deleteVAO h | ||
446 | return $ VAO h rkey | ||
447 | |||
448 | |||
449 | -- | Release the vao. | ||
450 | releaseVAO :: VAO -> Setup () | ||
451 | releaseVAO = release . vaoKey | ||
452 | |||
453 | |||
454 | -- | Delete the vao. | ||
455 | deleteVAO :: GLuint -> IO () | ||
456 | deleteVAO vao = Foreign.with vao $ glDeleteVertexArrays 1 | ||
457 | |||
458 | |||
459 | -- | Bind the vao. | ||
460 | bindVAO :: VAO -> IO () | ||
461 | bindVAO = glBindVertexArray . getVAO | ||
462 | |||
463 | |||
464 | -- | Enable the given vertex attribute of the bound vao. | ||
465 | -- | ||
466 | -- See also 'bindVAO'. | ||
467 | enableVAOAttrib :: GLuint -> IO () | ||
468 | enableVAOAttrib = glEnableVertexAttribArray | ||
469 | |||
470 | |||
471 | -- | Bind the bound buffer to the given point. | ||
472 | attribVAOPointer :: GLuint -> GLint -> GLenum -> Bool -> GLsizei -> Int -> IO () | ||
473 | attribVAOPointer idx ncomp dattype normalise stride off = | ||
474 | glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off) | ||
475 | |||
476 | |||
477 | -- | Draw the bound vao. | ||
478 | drawArrays :: GLenum -> Int -> Int -> IO () | ||
479 | drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count) | ||
480 | |||
481 | |||
482 | -- | Draw the bound vao, indexed mode. | ||
483 | drawElements :: GLenum -> Int -> GLenum -> Ptr a -> IO () | ||
484 | drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs | ||
485 | |||
486 | |||
487 | |||
488 | |||
489 | |||
490 | |||
491 | -- | ||
492 | -- BUFFER | ||
493 | -- | ||
494 | |||
495 | |||
496 | -- | An OpenGL buffer. | ||
497 | data GLBuffer = GLBuffer | ||
498 | { getBuffer :: GLuint | ||
499 | , rkey :: Resource | ||
500 | } | ||
501 | |||
502 | |||
503 | -- | The type of target buffer. | ||
504 | data TargetBuffer | ||
505 | = ArrayBuffer | ||
506 | | ElementArrayBuffer | ||
507 | | PixelPackBuffer | ||
508 | | PixelUnpackBuffer | ||
509 | deriving (Eq, Show) | ||
510 | |||
511 | |||
512 | fromTarget :: TargetBuffer -> GLenum | ||
513 | fromTarget ArrayBuffer = gl_ARRAY_BUFFER | ||
514 | fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER | ||
515 | fromTarget PixelPackBuffer = gl_PIXEL_PACK_BUFFER | ||
516 | fromTarget PixelUnpackBuffer = gl_PIXEL_UNPACK_BUFFER | ||
517 | |||
518 | |||
519 | -- | A buffer usage. | ||
520 | data BufferUsage | ||
521 | = StreamDraw | ||
522 | | StreamRead | ||
523 | | StreamCopy | ||
524 | | StaticDraw | ||
525 | | StaticRead | ||
526 | | StaticCopy | ||
527 | | DynamicDraw | ||
528 | | DynamicRead | ||
529 | | DynamicCopy | ||
530 | deriving (Eq, Show) | ||
531 | |||
532 | |||
533 | fromUsage :: BufferUsage -> GLenum | ||
534 | fromUsage StreamDraw = gl_STREAM_DRAW | ||
535 | fromUsage StreamRead = gl_STREAM_READ | ||
536 | fromUsage StreamCopy = gl_STREAM_COPY | ||
537 | fromUsage StaticDraw = gl_STATIC_DRAW | ||
538 | fromUsage StaticRead = gl_STATIC_READ | ||
539 | fromUsage StaticCopy = gl_STATIC_COPY | ||
540 | fromUsage DynamicDraw = gl_DYNAMIC_DRAW | ||
541 | fromUsage DynamicRead = gl_DYNAMIC_READ | ||
542 | fromUsage DynamicCopy = gl_DYNAMIC_COPY | ||
543 | |||
544 | |||
545 | -- | Create a new buffer. | ||
546 | newBuffer :: Setup GLBuffer | ||
547 | newBuffer = do | ||
548 | h <- setupIO . alloca $ \ptr -> do | ||
549 | glGenBuffers 1 ptr | ||
550 | peek ptr | ||
551 | |||
552 | rkey <- register $ deleteBuffer h | ||
553 | return $ GLBuffer h rkey | ||
554 | |||
555 | |||
556 | -- | Release the buffer. | ||
557 | releaseBuffer :: GLBuffer -> Setup () | ||
558 | releaseBuffer = release . rkey | ||
559 | |||
560 | |||
561 | -- | Delete the buffer. | ||
562 | deleteBuffer :: GLuint -> IO () | ||
563 | deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1 | ||
564 | |||
565 | |||
566 | -- | Bind the buffer. | ||
567 | bindBuffer :: GLBuffer -> TargetBuffer -> IO () | ||
568 | bindBuffer buf target = glBindBuffer (fromTarget target) $ getBuffer buf | ||
569 | |||
570 | |||
571 | -- | Set the buffer's data. | ||
572 | bufferData :: TargetBuffer -> Int -> Ptr a -> BufferUsage -> IO () | ||
573 | bufferData target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage) | ||
574 | |||
575 | |||
576 | -- | Apply the given function the buffer's id. | ||
577 | withGLBuffer :: GLBuffer -> (GLuint -> a) -> a | ||
578 | withGLBuffer buf f = f $ getBuffer buf | ||
579 | |||
580 | |||
581 | |||
582 | |||
583 | |||
584 | |||
585 | -- | ||
586 | -- TEXTURE | ||
587 | -- | ||
588 | |||
589 | -- | Represents a texture resource. | ||
590 | data Texture = Texture | ||
591 | { getTex :: GLuint | ||
592 | , texKey :: Resource | ||
593 | } | ||
594 | |||
595 | |||
596 | instance Eq Texture where | ||
597 | t1 == t2 = getTex t1 == getTex t2 | ||
598 | |||
599 | |||
600 | instance Ord Texture where | ||
601 | t1 < t2 = getTex t1 < getTex t2 | ||
602 | |||
603 | |||
604 | -- | Create a new texture. | ||
605 | newTexture :: Setup Texture | ||
606 | newTexture = do | ||
607 | tex <- setupIO . alloca $ \ptr -> do | ||
608 | glGenTextures 1 ptr | ||
609 | peek ptr | ||
610 | |||
611 | rkey <- register $ deleteTexture tex | ||
612 | return $ Texture tex rkey | ||
613 | |||
614 | |||
615 | -- | Release the texture. | ||
616 | releaseTexture :: Texture -> Setup () | ||
617 | releaseTexture = release . texKey | ||
618 | |||
619 | |||
620 | -- | Delete the texture. | ||
621 | deleteTexture :: GLuint -> IO () | ||
622 | --deleteTexture tex = with tex $ glDeleteTextures 1 | ||
623 | deleteTexture tex = do | ||
624 | putStrLn $ "Releasing texture " ++ show tex | ||
625 | with tex $ glDeleteTextures 1 | ||
626 | |||
627 | |||
628 | -- | Bind the texture. | ||
629 | bindTexture :: Texture -> IO () | ||
630 | bindTexture = glBindTexture gl_TEXTURE_2D . getTex | ||
631 | |||
632 | |||
633 | -- | Load data onto the bound texture. | ||
634 | -- | ||
635 | -- See also 'bindTexture'. | ||
636 | loadTextureData :: GLenum | ||
637 | -> Int -- ^ Target | ||
638 | -> Int -- ^ Level | ||
639 | -> Int -- ^ Internal format | ||
640 | -> Int -- ^ Width | ||
641 | -> Int -- ^ Height | ||
642 | -> GLenum -- ^ Border | ||
643 | -> GLenum -- ^ Texture type | ||
644 | -> Ptr a -- ^ Texture data | ||
645 | -> IO () | ||
646 | loadTextureData target level internalFormat width height border format texType texData = do | ||
647 | glTexImage2D target | ||
648 | (fromIntegral level) | ||
649 | (fromIntegral internalFormat) | ||
650 | (fromIntegral width) | ||
651 | (fromIntegral height) | ||
652 | (fromIntegral border) | ||
653 | (fromIntegral format) | ||
654 | texType | ||
655 | texData | ||
656 | |||
657 | |||
658 | -- | Set the bound texture's parameter to the given value. | ||
659 | texParami :: GLenum -> GLenum -> SettableStateVar GLenum | ||
660 | texParami target param = makeSettableStateVar $ \val -> glTexParameteri target param $ fromIntegral . fromEnum $ val | ||
661 | |||
662 | |||
663 | -- | Set the bound texture's parameter to the given value. | ||
664 | texParamf :: GLenum -> GLenum -> SettableStateVar Float | ||
665 | texParamf target param = makeSettableStateVar $ \val -> glTexParameterf target param (unsafeCoerce val) | ||
666 | |||
667 | |||
668 | -- | Set the active texture unit. | ||
669 | activeTexture :: SettableStateVar GLenum | ||
670 | activeTexture = makeSettableStateVar glActiveTexture | ||
671 | |||
672 | |||
673 | |||
674 | |||
675 | |||
676 | |||
677 | -- | ||
678 | -- ERROR | ||
679 | -- | ||
680 | |||
681 | |||
682 | -- | Get the last OpenGL error. | ||
683 | getGLError :: IO (Maybe String) | ||
684 | getGLError = fmap translate glGetError | ||
685 | where | ||
686 | translate err | ||
687 | | err == gl_NO_ERROR = Nothing | ||
688 | | err == gl_INVALID_ENUM = Just "Invalid enum" | ||
689 | | err == gl_INVALID_VALUE = Just "Invalid value" | ||
690 | | err == gl_INVALID_OPERATION = Just "Invalid operation" | ||
691 | | err == gl_OUT_OF_MEMORY = Just "Out of memory" | ||
692 | | otherwise = Just "Unknown error" | ||
693 | |||
694 | |||
695 | -- | Print the last OpenGL error. | ||
696 | printGLError :: IO () | ||
697 | printGLError = getGLError >>= \err -> case err of | ||
698 | Nothing -> return () | ||
699 | Just str -> hPutStrLn stderr str | ||
700 | |||
701 | |||
702 | -- | Run the given setup action and check for OpenGL errors. | ||
703 | -- | ||
704 | -- If an OpenGL error is produced, an exception is thrown containing | ||
705 | -- the given string appended to the string describing the error. | ||
706 | assertGL :: Setup a -> String -> Setup a | ||
707 | assertGL action err = do | ||
708 | result <- action | ||
709 | status <- setupIO getGLError | ||
710 | case status of | ||
711 | Just str -> setupError $ "OpenGL error raised: " ++ err ++ "; " ++ str | ||
712 | 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 @@ | |||
1 | module Spear.GLSL.Buffer | ||
2 | ( | ||
3 | GLBuffer | ||
4 | , TargetBuffer(..) | ||
5 | , BufferUsage(..) | ||
6 | , newBuffer | ||
7 | , releaseBuffer | ||
8 | , bindBuffer | ||
9 | , bufferData | ||
10 | , withGLBuffer | ||
11 | ) | ||
12 | where | ||
13 | |||
14 | |||
15 | import Spear.Setup | ||
16 | import Spear.GLSL.Management | ||
17 | |||
18 | import Graphics.Rendering.OpenGL.Raw.Core31 | ||
19 | import Control.Monad.Trans.Class (lift) | ||
20 | import Data.StateVar | ||
21 | import Foreign.Ptr | ||
22 | import Foreign.Marshal.Utils as Foreign (with) | ||
23 | import Foreign.Marshal.Alloc (alloca) | ||
24 | import Foreign.Storable (peek) | ||
25 | import Unsafe.Coerce | ||
26 | |||
27 | |||
28 | -- | Represents an OpenGL buffer. | ||
29 | data GLBuffer = GLBuffer | ||
30 | { getBuffer :: GLuint | ||
31 | , rkey :: Resource | ||
32 | } | ||
33 | |||
34 | |||
35 | -- | Represents a target buffer. | ||
36 | data TargetBuffer | ||
37 | = ArrayBuffer | ||
38 | | ElementArrayBuffer | ||
39 | | PixelPackBuffer | ||
40 | | PixelUnpackBuffer | ||
41 | deriving (Eq, Show) | ||
42 | |||
43 | |||
44 | fromTarget :: TargetBuffer -> GLenum | ||
45 | fromTarget ArrayBuffer = gl_ARRAY_BUFFER | ||
46 | fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER | ||
47 | fromTarget PixelPackBuffer = gl_PIXEL_PACK_BUFFER | ||
48 | fromTarget PixelUnpackBuffer = gl_PIXEL_UNPACK_BUFFER | ||
49 | |||
50 | |||
51 | -- | Represents a type of buffer usage. | ||
52 | data BufferUsage | ||
53 | = StreamDraw | ||
54 | | StreamRead | ||
55 | | StreamCopy | ||
56 | | StaticDraw | ||
57 | | StaticRead | ||
58 | | StaticCopy | ||
59 | | DynamicDraw | ||
60 | | DynamicRead | ||
61 | | DynamicCopy | ||
62 | deriving (Eq, Show) | ||
63 | |||
64 | |||
65 | fromUsage :: BufferUsage -> GLenum | ||
66 | fromUsage StreamDraw = gl_STREAM_DRAW | ||
67 | fromUsage StreamRead = gl_STREAM_READ | ||
68 | fromUsage StreamCopy = gl_STREAM_COPY | ||
69 | fromUsage StaticDraw = gl_STATIC_DRAW | ||
70 | fromUsage StaticRead = gl_STATIC_READ | ||
71 | fromUsage StaticCopy = gl_STATIC_COPY | ||
72 | fromUsage DynamicDraw = gl_DYNAMIC_DRAW | ||
73 | fromUsage DynamicRead = gl_DYNAMIC_READ | ||
74 | fromUsage DynamicCopy = gl_DYNAMIC_COPY | ||
75 | |||
76 | |||
77 | -- | Create a 'GLBuffer'. | ||
78 | newBuffer :: Setup GLBuffer | ||
79 | newBuffer = do | ||
80 | h <- setupIO . alloca $ \ptr -> do | ||
81 | glGenBuffers 1 ptr | ||
82 | peek ptr | ||
83 | |||
84 | rkey <- register $ deleteBuffer h | ||
85 | return $ GLBuffer h rkey | ||
86 | |||
87 | |||
88 | -- | Release the given 'GLBuffer'. | ||
89 | releaseBuffer :: GLBuffer -> Setup () | ||
90 | releaseBuffer = release . rkey | ||
91 | |||
92 | |||
93 | -- | Delete the given 'GLBuffer'. | ||
94 | deleteBuffer :: GLuint -> IO () | ||
95 | deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1 | ||
96 | |||
97 | |||
98 | -- | Bind the given 'GLBuffer'. | ||
99 | bindBuffer :: GLBuffer -> TargetBuffer -> IO () | ||
100 | bindBuffer buf target = glBindBuffer (fromTarget target) $ getBuffer buf | ||
101 | |||
102 | |||
103 | -- | Set buffer data. | ||
104 | bufferData :: TargetBuffer -> Int -> Ptr a -> BufferUsage -> IO () | ||
105 | bufferData target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage) | ||
106 | |||
107 | |||
108 | -- | Apply the given function the 'GLBuffer''s id. | ||
109 | withGLBuffer :: GLBuffer -> (GLuint -> a) -> a | ||
110 | withGLBuffer buf f = f $ getBuffer buf | ||
111 | |||
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 @@ | |||
1 | module Spear.GLSL.Error | ||
2 | ( | ||
3 | getGLError | ||
4 | , printGLError | ||
5 | , assertGL | ||
6 | ) | ||
7 | where | ||
8 | |||
9 | |||
10 | import Spear.Setup | ||
11 | |||
12 | import Graphics.Rendering.OpenGL.Raw.Core31 | ||
13 | import System.IO (hPutStrLn, stderr) | ||
14 | |||
15 | |||
16 | -- | Get the last OpenGL error. | ||
17 | getGLError :: IO (Maybe String) | ||
18 | getGLError = fmap translate glGetError | ||
19 | where | ||
20 | translate err | ||
21 | | err == gl_NO_ERROR = Nothing | ||
22 | | err == gl_INVALID_ENUM = Just "Invalid enum" | ||
23 | | err == gl_INVALID_VALUE = Just "Invalid value" | ||
24 | | err == gl_INVALID_OPERATION = Just "Invalid operation" | ||
25 | | err == gl_OUT_OF_MEMORY = Just "Out of memory" | ||
26 | | otherwise = Just "Unknown error" | ||
27 | |||
28 | |||
29 | -- | Print the last OpenGL error. | ||
30 | printGLError :: IO () | ||
31 | printGLError = getGLError >>= \err -> case err of | ||
32 | Nothing -> return () | ||
33 | Just str -> hPutStrLn stderr str | ||
34 | |||
35 | |||
36 | -- | Run the given 'Setup' action and check for OpenGL errors. | ||
37 | -- If an OpenGL error is produced, an exception is thrown | ||
38 | -- containing the given string and the OpenGL error. | ||
39 | assertGL :: Setup a -> String -> Setup a | ||
40 | assertGL action err = do | ||
41 | result <- action | ||
42 | status <- setupIO getGLError | ||
43 | case status of | ||
44 | Just str -> setupError $ "OpenGL error raised: " ++ err ++ "; " ++ str | ||
45 | 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 @@ | |||
1 | module Spear.GLSL.Management | ||
2 | ( | ||
3 | -- * Data types | ||
4 | GLSLShader | ||
5 | , GLSLProgram | ||
6 | , ShaderType(..) | ||
7 | -- * Program manipulation | ||
8 | , newProgram | ||
9 | , releaseProgram | ||
10 | , linkProgram | ||
11 | , useProgram | ||
12 | , withGLSLProgram | ||
13 | -- * Shader manipulation | ||
14 | , attachShader | ||
15 | , detachShader | ||
16 | , loadShader | ||
17 | , newShader | ||
18 | , releaseShader | ||
19 | -- ** Source loading | ||
20 | , loadSource | ||
21 | , shaderSource | ||
22 | , readSource | ||
23 | , compile | ||
24 | -- * Location | ||
25 | , attribLocation | ||
26 | , fragLocation | ||
27 | , uniformLocation | ||
28 | -- * Helper functions | ||
29 | , ($=) | ||
30 | , Data.StateVar.get | ||
31 | ) | ||
32 | where | ||
33 | |||
34 | |||
35 | import Spear.Setup | ||
36 | |||
37 | import Control.Monad ((<=<), forM) | ||
38 | import Control.Monad.Trans.State as State | ||
39 | import Control.Monad.Trans.Error | ||
40 | import Control.Monad.Trans.Class | ||
41 | import Control.Monad (mapM_, when) | ||
42 | import qualified Data.ByteString.Char8 as B | ||
43 | import Data.StateVar | ||
44 | import Foreign.Ptr | ||
45 | import Foreign.Storable | ||
46 | import Foreign.C.String | ||
47 | import Foreign.Marshal.Alloc (alloca) | ||
48 | import Foreign.Marshal.Array (withArray) | ||
49 | import Graphics.Rendering.OpenGL.Raw.Core31 | ||
50 | import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory) | ||
51 | import Unsafe.Coerce | ||
52 | |||
53 | |||
54 | -- | Represents a GLSL shader handle. | ||
55 | data GLSLShader = GLSLShader | ||
56 | { getShader :: GLuint | ||
57 | , getShaderKey :: Resource | ||
58 | } | ||
59 | |||
60 | |||
61 | -- | Represents a GLSL program handle. | ||
62 | data GLSLProgram = GLSLProgram | ||
63 | { getProgram :: GLuint | ||
64 | , getProgramKey :: Resource | ||
65 | } | ||
66 | |||
67 | |||
68 | -- | Encodes several shader types. | ||
69 | data ShaderType = VertexShader | FragmentShader deriving (Eq, Show) | ||
70 | |||
71 | |||
72 | toGLShader :: ShaderType -> GLenum | ||
73 | toGLShader VertexShader = gl_VERTEX_SHADER | ||
74 | toGLShader FragmentShader = gl_FRAGMENT_SHADER | ||
75 | |||
76 | |||
77 | -- | Apply the given function to the GLSLProgram's id. | ||
78 | withGLSLProgram :: GLSLProgram -> (GLuint -> a) -> a | ||
79 | withGLSLProgram prog f = f $ getProgram prog | ||
80 | |||
81 | |||
82 | -- | Get the location of the given uniform variable within the given program. | ||
83 | uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint | ||
84 | uniformLocation prog var = makeGettableStateVar get | ||
85 | where | ||
86 | get = withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str) | ||
87 | |||
88 | |||
89 | -- | Get or set the location of the given variable to a fragment shader colour number. | ||
90 | fragLocation :: GLSLProgram -> String -> StateVar GLint | ||
91 | fragLocation prog var = makeStateVar get set | ||
92 | where | ||
93 | get = withCString var $ \str -> glGetFragDataLocation (getProgram prog) (unsafeCoerce str) | ||
94 | set idx = withCString var $ \str -> | ||
95 | glBindFragDataLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str) | ||
96 | |||
97 | |||
98 | -- | Get or set the location of the given attribute within the given program. | ||
99 | attribLocation :: GLSLProgram -> String -> StateVar GLint | ||
100 | attribLocation prog var = makeStateVar get set | ||
101 | where | ||
102 | get = withCString var $ \str -> glGetAttribLocation (getProgram prog) (unsafeCoerce str) | ||
103 | set idx = withCString var $ \str -> | ||
104 | glBindAttribLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str) | ||
105 | |||
106 | |||
107 | -- | Create a 'GLSLProgram'. | ||
108 | newProgram :: [GLSLShader] -> Setup GLSLProgram | ||
109 | newProgram shaders = do | ||
110 | h <- setupIO glCreateProgram | ||
111 | when (h == 0) $ setupError "glCreateProgram failed" | ||
112 | rkey <- register $ deleteProgram h | ||
113 | let program = GLSLProgram h rkey | ||
114 | |||
115 | mapM_ (setupIO . attachShader program) shaders | ||
116 | linkProgram program | ||
117 | |||
118 | return program | ||
119 | |||
120 | |||
121 | -- | Release the given 'GLSLProgram'. | ||
122 | releaseProgram :: GLSLProgram -> Setup () | ||
123 | releaseProgram = release . getProgramKey | ||
124 | |||
125 | |||
126 | -- | Delete the given 'GLSLProgram'. | ||
127 | deleteProgram :: GLuint -> IO () | ||
128 | --deleteProgram = glDeleteProgram | ||
129 | deleteProgram prog = do | ||
130 | putStrLn $ "Deleting shader program " ++ show prog | ||
131 | glDeleteProgram prog | ||
132 | |||
133 | |||
134 | -- | Link the given GLSL program. | ||
135 | linkProgram :: GLSLProgram -> Setup () | ||
136 | linkProgram prog = do | ||
137 | let h = getProgram prog | ||
138 | err <- setupIO $ do | ||
139 | glLinkProgram h | ||
140 | alloca $ \statptr -> do | ||
141 | glGetProgramiv h gl_LINK_STATUS statptr | ||
142 | status <- peek statptr | ||
143 | case status of | ||
144 | 0 -> getStatus glGetProgramiv glGetProgramInfoLog h | ||
145 | _ -> return "" | ||
146 | |||
147 | case length err of | ||
148 | 0 -> return () | ||
149 | _ -> setupError err | ||
150 | |||
151 | |||
152 | -- | Use the given GLSL program. | ||
153 | useProgram :: GLSLProgram -> IO () | ||
154 | useProgram prog = glUseProgram $ getProgram prog | ||
155 | |||
156 | |||
157 | -- | Attach the given GLSL shader to the given GLSL program. | ||
158 | attachShader :: GLSLProgram -> GLSLShader -> IO () | ||
159 | attachShader prog shader = glAttachShader (getProgram prog) (getShader shader) | ||
160 | |||
161 | |||
162 | -- | Detach the given GLSL shader from the given GLSL program. | ||
163 | detachShader :: GLSLProgram -> GLSLShader -> IO () | ||
164 | detachShader prog shader = glDetachShader (getProgram prog) (getShader shader) | ||
165 | |||
166 | |||
167 | -- | Load a shader from the file specified by the given string. | ||
168 | -- | ||
169 | -- This function creates a new shader. To load source code into an existing shader, | ||
170 | -- see 'loadSource', 'shaderSource' and 'readSource'. | ||
171 | loadShader :: FilePath -> ShaderType -> Setup GLSLShader | ||
172 | loadShader file shaderType = do | ||
173 | shader <- newShader shaderType | ||
174 | loadSource file shader | ||
175 | compile file shader | ||
176 | return shader | ||
177 | |||
178 | |||
179 | -- | Create a new shader. | ||
180 | newShader :: ShaderType -> Setup GLSLShader | ||
181 | newShader shaderType = do | ||
182 | h <- setupIO $ glCreateShader (toGLShader shaderType) | ||
183 | case h of | ||
184 | 0 -> setupError "glCreateShader failed" | ||
185 | _ -> do | ||
186 | rkey <- register $ deleteShader h | ||
187 | return $ GLSLShader h rkey | ||
188 | |||
189 | |||
190 | -- | Release the given 'GLSLShader'. | ||
191 | releaseShader :: GLSLShader -> Setup () | ||
192 | releaseShader = release . getShaderKey | ||
193 | |||
194 | |||
195 | -- | Free the given shader. | ||
196 | deleteShader :: GLuint -> IO () | ||
197 | --deleteShader = glDeleteShader | ||
198 | deleteShader shader = do | ||
199 | putStrLn $ "Deleting shader " ++ show shader | ||
200 | glDeleteShader shader | ||
201 | |||
202 | |||
203 | -- | Load a shader source from the file specified by the given string into the given shader. | ||
204 | loadSource :: FilePath -> GLSLShader -> Setup () | ||
205 | loadSource file h = do | ||
206 | exists <- setupIO $ doesFileExist file | ||
207 | case exists of | ||
208 | False -> setupError "the specified shader file does not exist" | ||
209 | True -> setupIO $ do | ||
210 | code <- readSource file | ||
211 | withCString code $ shaderSource h | ||
212 | |||
213 | |||
214 | -- | Load the given shader source into the given shader. | ||
215 | shaderSource :: GLSLShader -> CString -> IO () | ||
216 | shaderSource shader str = | ||
217 | let ptr = unsafeCoerce str | ||
218 | in withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr | ||
219 | |||
220 | |||
221 | -- | Compile the given shader. | ||
222 | compile :: FilePath -> GLSLShader -> Setup () | ||
223 | compile file shader = do | ||
224 | let h = getShader shader | ||
225 | |||
226 | -- Compile | ||
227 | setupIO $ glCompileShader h | ||
228 | |||
229 | -- Verify status | ||
230 | err <- setupIO $ alloca $ \statusPtr -> do | ||
231 | glGetShaderiv h gl_COMPILE_STATUS statusPtr | ||
232 | result <- peek statusPtr | ||
233 | case result of | ||
234 | 0 -> getStatus glGetShaderiv glGetShaderInfoLog h | ||
235 | _ -> return "" | ||
236 | |||
237 | case length err of | ||
238 | 0 -> return () | ||
239 | _ -> setupError $ "Unable to compile shader " ++ file ++ ":\n" ++ err | ||
240 | |||
241 | |||
242 | type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO () | ||
243 | type LogCall = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO () | ||
244 | |||
245 | |||
246 | getStatus :: StatusCall -> LogCall -> GLuint -> IO String | ||
247 | getStatus getStatus getLog h = do | ||
248 | alloca $ \lenPtr -> do | ||
249 | getStatus h gl_INFO_LOG_LENGTH lenPtr | ||
250 | len <- peek lenPtr | ||
251 | case len of | ||
252 | 0 -> return "" | ||
253 | _ -> withCString (replicate (unsafeCoerce len) '\0') $ getErrorString getLog h (unsafeCoerce len) | ||
254 | |||
255 | |||
256 | getErrorString :: LogCall -> GLuint -> GLsizei -> CString -> IO String | ||
257 | getErrorString getLog h len str = do | ||
258 | let ptr = unsafeCoerce str | ||
259 | getLog h len nullPtr ptr | ||
260 | peekCString str | ||
261 | |||
262 | |||
263 | -- | Load the shader source specified by the given file. | ||
264 | -- | ||
265 | -- This function implements an #include mechanism, so the given file can | ||
266 | -- refer to other files. | ||
267 | readSource :: FilePath -> IO String | ||
268 | readSource = fmap B.unpack . readSource' | ||
269 | |||
270 | |||
271 | readSource' :: FilePath -> IO B.ByteString | ||
272 | readSource' file = do | ||
273 | let includeB = B.pack "#include" | ||
274 | newLineB = B.pack "\n" | ||
275 | isInclude = ((==) includeB) . B.take 8 | ||
276 | clean = B.dropWhile (\c -> c == ' ') | ||
277 | cleanInclude = B.filter (\c -> c /= '"') . B.dropWhile (\c -> c /= ' ') | ||
278 | toLines = B.splitWith (\c -> c == '\n' || c == '\r') | ||
279 | addNewLine s = if (B.last s /= '\n') then B.append s newLineB else s | ||
280 | parse = fmap B.concat . (fmap . fmap $ flip B.append newLineB) . sequence . | ||
281 | fmap (processLine . clean) . toLines | ||
282 | processLine l = | ||
283 | if isInclude l | ||
284 | then readSource' $ B.unpack . clean . cleanInclude $ l | ||
285 | else return l | ||
286 | |||
287 | contents <- B.readFile file | ||
288 | |||
289 | dir <- getCurrentDirectory | ||
290 | let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file | ||
291 | |||
292 | setCurrentDirectory dir' | ||
293 | code <- parse contents | ||
294 | setCurrentDirectory dir | ||
295 | |||
296 | return code | ||
297 | |||
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 @@ | |||
1 | module Spear.GLSL.Texture | ||
2 | ( | ||
3 | Texture | ||
4 | , SettableStateVar | ||
5 | , GLenum | ||
6 | , ($) | ||
7 | -- * Creation and destruction | ||
8 | , newTexture | ||
9 | , releaseTexture | ||
10 | -- * Manipulation | ||
11 | , bindTexture | ||
12 | , loadTextureData | ||
13 | , texParami | ||
14 | , texParamf | ||
15 | , activeTexture | ||
16 | ) | ||
17 | where | ||
18 | |||
19 | |||
20 | import Spear.Setup | ||
21 | |||
22 | import Data.StateVar | ||
23 | import Foreign.Marshal.Alloc (alloca) | ||
24 | import Foreign.Marshal.Utils (with) | ||
25 | import Foreign.Ptr | ||
26 | import Foreign.Storable (peek) | ||
27 | import Graphics.Rendering.OpenGL.Raw.Core31 | ||
28 | import Unsafe.Coerce (unsafeCoerce) | ||
29 | |||
30 | |||
31 | -- | Represents a texture resource. | ||
32 | data Texture = Texture | ||
33 | { getTex :: GLuint | ||
34 | , rkey :: Resource | ||
35 | } | ||
36 | |||
37 | |||
38 | instance Eq Texture where | ||
39 | t1 == t2 = getTex t1 == getTex t2 | ||
40 | |||
41 | |||
42 | instance Ord Texture where | ||
43 | t1 < t2 = getTex t1 < getTex t2 | ||
44 | |||
45 | |||
46 | -- | Create a new 'Texture'. | ||
47 | newTexture :: Setup Texture | ||
48 | newTexture = do | ||
49 | tex <- setupIO . alloca $ \ptr -> do | ||
50 | glGenTextures 1 ptr | ||
51 | peek ptr | ||
52 | |||
53 | rkey <- register $ deleteTexture tex | ||
54 | return $ Texture tex rkey | ||
55 | |||
56 | |||
57 | -- | Release the given 'Texture'. | ||
58 | releaseTexture :: Texture -> Setup () | ||
59 | releaseTexture = release . rkey | ||
60 | |||
61 | |||
62 | -- | Delete the given 'Texture'. | ||
63 | deleteTexture :: GLuint -> IO () | ||
64 | --deleteTexture tex = with tex $ glDeleteTextures 1 | ||
65 | deleteTexture tex = do | ||
66 | putStrLn $ "Releasing texture " ++ show tex | ||
67 | with tex $ glDeleteTextures 1 | ||
68 | |||
69 | |||
70 | -- | Bind the given 'Texture'. | ||
71 | bindTexture :: Texture -> IO () | ||
72 | bindTexture = glBindTexture gl_TEXTURE_2D . getTex | ||
73 | |||
74 | |||
75 | -- | Load data onto the bound 'Texture'. | ||
76 | loadTextureData :: GLenum | ||
77 | -> Int -- ^ Target | ||
78 | -> Int -- ^ Level | ||
79 | -> Int -- ^ Internal format | ||
80 | -> Int -- ^ Width | ||
81 | -> Int -- ^ Height | ||
82 | -> GLenum -- ^ Border | ||
83 | -> GLenum -- ^ Texture type | ||
84 | -> Ptr a -- ^ Texture data | ||
85 | -> IO () | ||
86 | loadTextureData target level internalFormat width height border format texType texData = do | ||
87 | glTexImage2D target | ||
88 | (fromIntegral level) | ||
89 | (fromIntegral internalFormat) | ||
90 | (fromIntegral width) | ||
91 | (fromIntegral height) | ||
92 | (fromIntegral border) | ||
93 | (fromIntegral format) | ||
94 | texType | ||
95 | texData | ||
96 | |||
97 | |||
98 | -- | Set the bound texture's given parameter to the given value. | ||
99 | texParami :: GLenum -> GLenum -> SettableStateVar GLenum | ||
100 | texParami target param = makeSettableStateVar $ \val -> glTexParameteri target param $ fromIntegral . fromEnum $ val | ||
101 | |||
102 | |||
103 | -- | Set the bound texture's given parameter to the given value. | ||
104 | texParamf :: GLenum -> GLenum -> SettableStateVar Float | ||
105 | texParamf target param = makeSettableStateVar $ \val -> glTexParameterf target param (unsafeCoerce val) | ||
106 | |||
107 | |||
108 | -- | Set the active texture unit. | ||
109 | activeTexture :: SettableStateVar GLenum | ||
110 | 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 @@ | |||
1 | module Spear.GLSL.Uniform | ||
2 | ( | ||
3 | uniformVec3 | ||
4 | , uniformVec4 | ||
5 | , uniformMat3 | ||
6 | , uniformMat4 | ||
7 | , uniformfl | ||
8 | , uniformil | ||
9 | ) | ||
10 | where | ||
11 | |||
12 | |||
13 | import Spear.GLSL.Management | ||
14 | import Spear.Math.Matrix3 (Matrix3) | ||
15 | import Spear.Math.Matrix4 (Matrix4) | ||
16 | import Spear.Math.Vector3 as V3 | ||
17 | import Spear.Math.Vector4 as V4 | ||
18 | |||
19 | import Foreign.Marshal.Array (withArray) | ||
20 | import Foreign.Marshal.Utils | ||
21 | import Graphics.Rendering.OpenGL.Raw.Core31 | ||
22 | import Unsafe.Coerce | ||
23 | |||
24 | |||
25 | uniformVec3 :: GLint -> Vector3 -> IO () | ||
26 | uniformVec3 loc v = glUniform3f loc x' y' z' | ||
27 | where x' = unsafeCoerce $ V3.x v | ||
28 | y' = unsafeCoerce $ V3.y v | ||
29 | z' = unsafeCoerce $ V3.z v | ||
30 | |||
31 | |||
32 | uniformVec4 :: GLint -> Vector4 -> IO () | ||
33 | uniformVec4 loc v = glUniform4f loc x' y' z' w' | ||
34 | where x' = unsafeCoerce $ V4.x v | ||
35 | y' = unsafeCoerce $ V4.y v | ||
36 | z' = unsafeCoerce $ V4.z v | ||
37 | w' = unsafeCoerce $ V4.w v | ||
38 | |||
39 | |||
40 | uniformMat3 :: GLint -> Matrix3 -> IO () | ||
41 | uniformMat3 loc mat = | ||
42 | with mat $ \ptrMat -> | ||
43 | glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | ||
44 | |||
45 | |||
46 | uniformMat4 :: GLint -> Matrix4 -> IO () | ||
47 | uniformMat4 loc mat = | ||
48 | with mat $ \ptrMat -> | ||
49 | glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | ||
50 | |||
51 | |||
52 | uniformfl :: GLint -> [GLfloat] -> IO () | ||
53 | uniformfl loc vals = withArray vals $ \ptr -> | ||
54 | case length vals of | ||
55 | 1 -> glUniform1fv loc 1 ptr | ||
56 | 2 -> glUniform2fv loc 1 ptr | ||
57 | 3 -> glUniform3fv loc 1 ptr | ||
58 | 4 -> glUniform4fv loc 1 ptr | ||
59 | |||
60 | |||
61 | uniformil :: GLint -> [GLint] -> IO () | ||
62 | uniformil loc vals = withArray vals $ \ptr -> | ||
63 | case length vals of | ||
64 | 1 -> glUniform1iv loc 1 ptr | ||
65 | 2 -> glUniform2iv loc 1 ptr | ||
66 | 3 -> glUniform3iv loc 1 ptr | ||
67 | 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 @@ | |||
1 | module Spear.GLSL.VAO | ||
2 | ( | ||
3 | VAO | ||
4 | -- * Creation and destruction | ||
5 | , newVAO | ||
6 | , releaseVAO | ||
7 | -- * Manipulation | ||
8 | , bindVAO | ||
9 | , enableVAOAttrib | ||
10 | , attribVAOPointer | ||
11 | -- * Rendering | ||
12 | , drawArrays | ||
13 | , drawElements | ||
14 | ) | ||
15 | where | ||
16 | |||
17 | |||
18 | import Spear.Setup | ||
19 | import Control.Monad.Trans.Class (lift) | ||
20 | import Foreign.Marshal.Utils as Foreign (with) | ||
21 | import Foreign.Marshal.Alloc (alloca) | ||
22 | import Foreign.Storable (peek) | ||
23 | import Foreign.Ptr | ||
24 | import Unsafe.Coerce | ||
25 | import Graphics.Rendering.OpenGL.Raw.Core31 | ||
26 | |||
27 | |||
28 | -- | Represents a vertex array object. | ||
29 | data VAO = VAO | ||
30 | { getVAO :: GLuint | ||
31 | , rkey :: Resource | ||
32 | } | ||
33 | |||
34 | |||
35 | instance Eq VAO where | ||
36 | vao1 == vao2 = getVAO vao1 == getVAO vao2 | ||
37 | |||
38 | |||
39 | instance Ord VAO where | ||
40 | vao1 < vao2 = getVAO vao1 < getVAO vao2 | ||
41 | |||
42 | |||
43 | -- | Create a new 'VAO'. | ||
44 | newVAO :: Setup VAO | ||
45 | newVAO = do | ||
46 | h <- setupIO . alloca $ \ptr -> do | ||
47 | glGenVertexArrays 1 ptr | ||
48 | peek ptr | ||
49 | |||
50 | rkey <- register $ deleteVAO h | ||
51 | return $ VAO h rkey | ||
52 | |||
53 | |||
54 | -- | Release the given 'VAO'. | ||
55 | releaseVAO :: VAO -> Setup () | ||
56 | releaseVAO = release . rkey | ||
57 | |||
58 | |||
59 | -- | Delete the given 'VAO'. | ||
60 | deleteVAO :: GLuint -> IO () | ||
61 | deleteVAO vao = Foreign.with vao $ glDeleteVertexArrays 1 | ||
62 | |||
63 | |||
64 | -- | Bind the given 'VAO'. | ||
65 | bindVAO :: VAO -> IO () | ||
66 | bindVAO = glBindVertexArray . getVAO | ||
67 | |||
68 | |||
69 | -- | Enable the given vertex attribute of the bound 'VAO'. | ||
70 | enableVAOAttrib :: GLuint -> IO () | ||
71 | enableVAOAttrib = glEnableVertexAttribArray | ||
72 | |||
73 | |||
74 | -- | Bind the bound buffer to the given point. | ||
75 | attribVAOPointer :: GLuint -> GLint -> GLenum -> Bool -> GLsizei -> Int -> IO () | ||
76 | attribVAOPointer idx ncomp dattype normalise stride off = | ||
77 | glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off) | ||
78 | |||
79 | |||
80 | -- | Draw the bound 'VAO'. | ||
81 | drawArrays :: GLenum -> Int -> Int -> IO () | ||
82 | drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count) | ||
83 | |||
84 | |||
85 | -- | Draw the bound 'VAO', indexed mode. | ||
86 | drawElements :: GLenum -> Int -> GLenum -> Ptr a -> IO () | ||
87 | drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs | ||
88 | |||
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 | |||
12 | where | 12 | where |
13 | 13 | ||
14 | 14 | ||
15 | import Spear.GLSL.Management (GLSLProgram) | 15 | import Spear.GLSL (GLSLProgram) |
16 | 16 | ||
17 | 17 | ||
18 | import Graphics.Rendering.OpenGL.Raw.Core31 | 18 | 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 | |||
7 | 7 | ||
8 | import Spear.Setup | 8 | import Spear.Setup |
9 | import Spear.Assets.Image | 9 | import Spear.Assets.Image |
10 | import Spear.GLSL.Texture | 10 | import Spear.GLSL |
11 | import Data.StateVar (($=)) | 11 | import Data.StateVar (($=)) |
12 | import Graphics.Rendering.OpenGL.Raw.Core31 | 12 | import Graphics.Rendering.OpenGL.Raw.Core31 |
13 | 13 | ||
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 | |||
25 | 25 | ||
26 | import Spear.Collision.Collision | 26 | import Spear.Collision.Collision |
27 | import Spear.Collision.Collisioner as Col | 27 | import Spear.Collision.Collisioner as Col |
28 | import Spear.GLSL.Management | 28 | import Spear.GLSL |
29 | import Spear.GLSL.Uniform | ||
30 | import Spear.Math.AABB | 29 | import Spear.Math.AABB |
31 | import qualified Spear.Math.Camera as Cam | 30 | import qualified Spear.Math.Camera as Cam |
32 | import qualified Spear.Math.Matrix3 as M3 | 31 | import qualified Spear.Math.Matrix3 as M3 |