aboutsummaryrefslogtreecommitdiff
path: root/Spear/Render/Core
diff options
context:
space:
mode:
Diffstat (limited to 'Spear/Render/Core')
-rw-r--r--Spear/Render/Core/Buffer.hs122
-rw-r--r--Spear/Render/Core/Constants.hs12
-rw-r--r--Spear/Render/Core/Geometry.hs150
-rw-r--r--Spear/Render/Core/Pipeline.hs74
-rw-r--r--Spear/Render/Core/Shader.hs216
-rw-r--r--Spear/Render/Core/State.hs157
6 files changed, 731 insertions, 0 deletions
diff --git a/Spear/Render/Core/Buffer.hs b/Spear/Render/Core/Buffer.hs
new file mode 100644
index 0000000..6f1e355
--- /dev/null
+++ b/Spear/Render/Core/Buffer.hs
@@ -0,0 +1,122 @@
1module Spear.Render.Core.Buffer
2(
3 BufferData(..)
4, BufferDesc(..)
5, makeBufferAndView
6, makeBuffer
7, deleteBuffer
8, updateBuffer
9)
10where
11
12import Spear.Game
13import Spear.Math.Vector
14import Spear.Render.Core.State
15
16import Control.Monad (void)
17import Data.HashMap as HashMap
18import Data.Word
19import Foreign.C.Types
20import Foreign.Marshal.Alloc
21import Foreign.Marshal.Array
22import Foreign.Ptr
23import Foreign.Storable
24import Graphics.GL.Core46
25import Unsafe.Coerce
26
27
28data BufferData
29 = BufferDataUntyped (Ptr Word8) GLuint
30 | BufferDataVec2 [Vector2]
31 | BufferDataVec3 [Vector3]
32 | BufferDataFloat [Float]
33 | BufferDataU8 [Word8]
34 | BufferDataU16 [Word16]
35 | BufferUninitialized
36
37data BufferDesc = BufferDesc
38 { bufferDescUsage :: BufferUsage
39 , bufferDescType :: BufferType
40 , bufferDescData :: BufferData
41 }
42
43
44makeBufferAndView :: BufferDesc -> Game RenderCoreState (BufferView a)
45makeBufferAndView desc = do
46 buffer <- makeBuffer desc
47 return BufferView
48 { bufferViewBuffer = buffer
49 , bufferViewOffsetBytes = 0
50 , bufferViewSizeBytes = bufferDataSizeBytes $ bufferDescData desc
51 , bufferViewStrideBytes = 0
52 }
53
54makeBuffer :: BufferDesc -> Game RenderCoreState Buffer
55makeBuffer (BufferDesc usage bufferType bufferData) = do
56 handle <- gameIO $ alloca $ \ptr -> glGenBuffers 1 ptr >> peek ptr
57 resourceKey <- register $ deleteBuffer' handle
58 let buffer = Buffer handle resourceKey bufferType usage
59 gameIO $ updateBuffer buffer bufferData
60 modifyGameState (\state -> state {
61 buffers = HashMap.insert handle buffer (buffers state) })
62 return buffer
63
64deleteBuffer :: Buffer -> Game RenderCoreState ()
65deleteBuffer buffer = do
66 let matches buffer = (==bufferHandle buffer) . bufferHandle
67 modifyGameState (\state -> state {
68 buffers = HashMap.delete (bufferHandle buffer) (buffers state) })
69 release buffer
70
71-- TODO: use glBufferSubData for updates.
72updateBuffer :: Buffer -> BufferData -> IO ()
73updateBuffer buffer bufferData =
74 case bufferData of
75 BufferUninitialized -> return ()
76 _ -> do
77 glBindBuffer GL_ARRAY_BUFFER (bufferHandle buffer)
78 uploadData (bufferUsage buffer) bufferData
79 glBindBuffer GL_ARRAY_BUFFER 0
80
81-- Private
82
83deleteBuffer' :: GLuint -> IO ()
84deleteBuffer' handle = alloca $ \ptr -> do
85 poke ptr handle
86 glDeleteBuffers 1 ptr
87
88uploadData :: BufferUsage -> BufferData -> IO ()
89uploadData usage bufferData = case bufferData of
90 BufferDataUntyped ptr sizeBytes -> do
91 glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) (unsafeCoerce ptr) usage'
92 BufferDataVec2 vec2s -> withArrayLen vec2s $ \numElems ptr -> do
93 let sizeBytes = numElems * sizeOf (undefined :: Vector2)
94 glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
95 BufferDataVec3 vec3s -> withArrayLen vec3s $ \numElems ptr -> do
96 let sizeBytes = numElems * sizeOf (undefined :: Vector3)
97 glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
98 BufferDataFloat floats -> withArrayLen floats $ \numElems ptr -> do
99 let sizeBytes = numElems * sizeOf (undefined :: CFloat)
100 glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
101 BufferDataU8 ints -> withArrayLen ints $ \numElems ptr -> do
102 let sizeBytes = numElems * sizeOf (undefined :: Word8)
103 glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
104 BufferDataU16 ints -> withArrayLen ints $ \numElems ptr -> do
105 let sizeBytes = numElems * sizeOf (undefined :: Word16)
106 glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
107 BufferUninitialized ->
108 return ()
109 where usage' = toGLUsage usage
110
111toGLUsage :: BufferUsage -> GLenum
112toGLUsage BufferStatic = GL_STATIC_DRAW
113toGLUsage BufferDynamic = GL_DYNAMIC_DRAW
114
115bufferDataSizeBytes :: BufferData -> GLuint
116bufferDataSizeBytes bufferData = case bufferData of
117 BufferDataUntyped ptr sizeBytes -> sizeBytes
118 BufferDataVec2 vec2s -> fromIntegral $ length vec2s * sizeOf (undefined :: Vector2)
119 BufferDataVec3 vec3s -> fromIntegral $ length vec3s * sizeOf (undefined :: Vector3)
120 BufferDataFloat floats -> fromIntegral $ length floats * 4
121 BufferDataU8 bytes -> fromIntegral $ length bytes
122 BufferDataU16 words -> fromIntegral $ length words * 2
diff --git a/Spear/Render/Core/Constants.hs b/Spear/Render/Core/Constants.hs
new file mode 100644
index 0000000..befd8ed
--- /dev/null
+++ b/Spear/Render/Core/Constants.hs
@@ -0,0 +1,12 @@
1module Spear.Render.Core.Constants where
2
3
4import Graphics.GL.Core46
5
6
7positionChannel = 0 :: GLuint
8normalChannel = 1 :: GLuint
9tangentChannel = 2 :: GLuint
10texcoordsChannel = 3 :: GLuint
11jointsChannel = 4 :: GLuint
12weightsChannel = 5 :: GLuint
diff --git a/Spear/Render/Core/Geometry.hs b/Spear/Render/Core/Geometry.hs
new file mode 100644
index 0000000..aa0dfe5
--- /dev/null
+++ b/Spear/Render/Core/Geometry.hs
@@ -0,0 +1,150 @@
1module Spear.Render.Core.Geometry
2(
3 newGeometryDesc
4, makeGeometry
5, deleteGeometry
6, renderGeometry
7, setPositions
8)
9where
10
11
12import Spear.Game
13import Spear.Math.Vector.Vector3
14import Spear.Render.Core.Buffer
15import Spear.Render.Core.Constants
16import Spear.Render.Core.State
17
18import Data.HashMap as HashMap
19import Data.IORef
20import Foreign.Marshal.Alloc
21import Foreign.Storable
22import Graphics.GL.Core46
23import Unsafe.Coerce
24
25
26newGeometryDesc :: GeometryDesc
27newGeometryDesc = GeometryDesc
28 { positions = Nothing
29 , normals = Nothing
30 , tangents = Nothing
31 , texcoords = Nothing
32 , joints = Nothing
33 , weights = Nothing
34 , indices = Nothing
35 , numVerts = 0
36 , numIndices = 0
37 , primitiveType = Triangles
38 }
39
40
41makeGeometry :: GeometryDesc -> Game RenderCoreState Geometry
42makeGeometry desc = do
43 handle <- gameIO $ alloca $ \ptr -> glGenVertexArrays 1 ptr >> peek ptr
44 gameIO $ do
45 glBindVertexArray handle
46 configureVertexAttributes desc
47 glBindVertexArray 0
48 descRef <- gameIO $ newIORef desc
49 resourceKey <- register $ deleteGeometry' handle
50 let geometry = Geometry handle resourceKey descRef
51 modifyGameState (\state -> state {
52 geometries = HashMap.insert handle geometry (geometries state) })
53 return geometry
54
55deleteGeometry :: Geometry -> Game RenderCoreState ()
56deleteGeometry geometry = do
57 modifyGameState (\state -> state {
58 geometries = HashMap.delete (geometryVao geometry) (geometries state) })
59 release geometry
60
61renderGeometry :: Geometry -> IO ()
62renderGeometry geometry = do
63 desc <- readIORef (geometryDesc geometry)
64 let mode = toGLPrimitiveType $ primitiveType desc
65 glBindVertexArray (geometryVao geometry)
66 case indices desc of
67 (Just (IndicesU8 view)) -> renderIndexed view mode (numIndices desc) GL_UNSIGNED_BYTE
68 (Just (IndicesU16 view)) -> renderIndexed view mode (numIndices desc) GL_UNSIGNED_SHORT
69 Nothing -> glDrawArrays mode 0 (numVerts desc)
70 glBindVertexArray 0
71
72-- Functions for updating dynamic geometry.
73
74setPositions :: Geometry -> [Vector3] -> IO ()
75setPositions geometry vectors = do
76 desc <- readIORef $ geometryDesc geometry
77 case positions desc of
78 Just (Positions3d view) -> do
79 updateBuffer (bufferViewBuffer view) (BufferDataVec3 vectors)
80 updateGeometry geometry $ \desc -> desc {
81 numVerts = fromIntegral . length $ vectors
82 }
83 _ -> putStrLn "setPositions ERROR" -- TODO: handle gracefully
84
85-- Private
86
87deleteGeometry' :: GLenum -> IO ()
88deleteGeometry' handle = alloca $ \ptr -> do
89 poke ptr handle
90 glDeleteVertexArrays 1 ptr
91
92updateGeometry :: Geometry -> (GeometryDesc -> GeometryDesc) -> IO ()
93updateGeometry geometry update = do
94 desc <- readIORef $ geometryDesc geometry
95 writeIORef (geometryDesc geometry) (update desc)
96
97renderIndexed :: BufferView a -> GLenum -> GLsizei -> GLenum -> IO ()
98renderIndexed view mode numIndices indexElemSize = do
99 glBindBuffer GL_ELEMENT_ARRAY_BUFFER (bufferHandle . bufferViewBuffer $ view)
100 glDrawElements mode numIndices GL_UNSIGNED_SHORT (unsafeCoerce $ bufferViewOffsetBytes view)
101 glBindBuffer GL_ELEMENT_ARRAY_BUFFER 0
102
103configureVertexAttributes :: GeometryDesc -> IO ()
104configureVertexAttributes desc = do
105 case positions desc of
106 Just (Positions2d view) -> configureView view positionChannel 2 GL_FLOAT GL_FALSE
107 Just (Positions3d view) -> configureView view positionChannel 3 GL_FLOAT GL_FALSE
108 Nothing -> return ()
109 case normals desc of
110 Just view -> configureView view normalChannel 3 GL_FLOAT GL_FALSE
111 Nothing -> return ()
112 case tangents desc of
113 Just view -> configureView view tangentChannel 4 GL_FLOAT GL_FALSE
114 Nothing -> return ()
115 case texcoords desc of
116 Just view -> configureView view texcoordsChannel 2 GL_FLOAT GL_FALSE
117 Nothing -> return ()
118 case joints desc of
119 Just (JointsU8 view) -> configureView view jointsChannel 4 GL_UNSIGNED_BYTE GL_FALSE
120 Just (JointsU16 view) -> configureView view jointsChannel 4 GL_UNSIGNED_SHORT GL_FALSE
121 Nothing -> return ()
122 case weights desc of
123 Just (WeightsU8 view) -> configureView view weightsChannel 4 GL_UNSIGNED_BYTE GL_TRUE
124 Just (WeightsU16 view) -> configureView view weightsChannel 4 GL_UNSIGNED_SHORT GL_TRUE
125 Just (WeightsFloat view) -> configureView view weightsChannel 4 GL_FLOAT GL_FALSE
126 Nothing -> return ()
127
128-- TODO: Add the assertion:
129-- desc->num_verts <= view->size_bytes / (num_components * component_size_bytes
130configureView :: BufferView a -> GLuint -> GLint -> GLenum -> GLboolean -> IO ()
131configureView view channel numComponents componentType normalized = do
132 glBindBuffer GL_ARRAY_BUFFER (bufferHandle . bufferViewBuffer $ view)
133 glEnableVertexAttribArray channel
134 let strideBytes = bufferViewStrideBytes view
135 let offsetBytes = unsafeCoerce $ bufferViewOffsetBytes view
136 if (componentType == GL_FLOAT) || (normalized == GL_TRUE)
137 then do
138 glVertexAttribPointer channel numComponents componentType normalized
139 strideBytes offsetBytes
140 else
141 -- TODO: Assert component type
142 glVertexAttribIPointer channel numComponents componentType
143 strideBytes offsetBytes
144 glBindBuffer GL_ARRAY_BUFFER 0
145
146toGLPrimitiveType :: PrimitiveType -> GLenum
147toGLPrimitiveType primitiveType = case primitiveType of
148 Triangles -> GL_TRIANGLES
149 TriangleFan -> GL_TRIANGLE_FAN
150 TriangleStrip -> GL_TRIANGLE_STRIP
diff --git a/Spear/Render/Core/Pipeline.hs b/Spear/Render/Core/Pipeline.hs
new file mode 100644
index 0000000..724b391
--- /dev/null
+++ b/Spear/Render/Core/Pipeline.hs
@@ -0,0 +1,74 @@
1module Spear.Render.Core.Pipeline
2(
3 BufferTarget(..)
4, clearBuffers
5, setBlending
6, setClearColour
7, setClearDepth
8, setClearStencil
9, setCulling
10, setDepthMask
11, setPolygonOffset
12, setViewport
13)
14where
15
16import Data.Bits ((.|.))
17import Data.List (foldl')
18import Graphics.GL.Core46
19
20
21data BufferTarget
22 = ColourBuffer
23 | DepthBuffer
24 | StencilBuffer
25
26
27clearBuffers :: [BufferTarget] -> IO ()
28clearBuffers = glClear . toBufferBitfield
29 where toBufferBitfield = foldl' (.|.) 0 . (<$>) toGLEnum
30 toGLEnum target = case target of
31 ColourBuffer -> GL_COLOR_BUFFER_BIT
32 DepthBuffer -> GL_DEPTH_BUFFER_BIT
33 StencilBuffer -> GL_STENCIL_BUFFER_BIT
34
35setBlending :: Bool -> IO ()
36setBlending enable =
37 if enable
38 then glEnable GL_BLEND >> glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
39 else glDisable GL_BLEND
40
41setClearColour :: (Float, Float, Float, Float) -> IO ()
42setClearColour (r,g,b,a) = glClearColor r g b a
43
44setClearDepth :: Double -> IO ()
45setClearDepth = glClearDepth
46
47setClearStencil :: Int -> IO ()
48setClearStencil = glClearStencil . fromIntegral
49
50setCulling :: Bool -> IO ()
51setCulling enable = (if enable then glEnable else glDisable) GL_CULL_FACE
52
53setDepthMask :: Bool -> IO ()
54setDepthMask enable = glDepthMask (if enable then GL_TRUE else GL_FALSE)
55
56setPolygonOffset :: Float -> Float -> IO ()
57setPolygonOffset scale bias = do
58 glPolygonOffset scale bias
59 if scale /= 0 && bias /= 0
60 then glEnable GL_POLYGON_OFFSET_FILL
61 else glDisable GL_POLYGON_OFFSET_FILL
62
63setViewport ::
64 -- | x
65 Int ->
66 -- | y
67 Int ->
68 -- | width
69 Int ->
70 -- | height
71 Int ->
72 IO ()
73setViewport x y width height =
74 glViewport (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height)
diff --git a/Spear/Render/Core/Shader.hs b/Spear/Render/Core/Shader.hs
new file mode 100644
index 0000000..4ed4430
--- /dev/null
+++ b/Spear/Render/Core/Shader.hs
@@ -0,0 +1,216 @@
1module Spear.Render.Core.Shader
2(
3 Define(..)
4, ShaderSource(..)
5, ShaderDesc(..)
6, compileShader
7, compileShaderProgram
8, deleteShader
9, deleteShaderProgram
10, activateShaderProgram
11, deactivateShaderProgram
12, setUniform
13, applyUniforms
14)
15where
16
17import Spear.Game
18import Spear.Math.Matrix4
19import Spear.Math.Vector
20import Spear.Render.Core.State
21
22import Control.Monad (mapM_)
23import Data.Bits
24import Data.Hashable
25import Data.HashMap as HashMap
26import Data.IORef
27import Data.List (deleteBy, foldl', intercalate)
28import Foreign.C.String
29import Foreign.Marshal.Alloc
30import Foreign.Marshal.Array
31import Foreign.Marshal.Utils
32import Foreign.Ptr
33import Foreign.Storable
34import Graphics.GL.Core46
35import Unsafe.Coerce
36
37
38type Define = (String, String)
39
40data ShaderSource
41 = ShaderFromString String
42 | ShaderFromFile FilePath
43 deriving Show
44
45data ShaderDesc = ShaderDesc
46 { shaderDescType :: ShaderType
47 , shaderDescSource :: ShaderSource
48 , shaderDescDefines :: [Define]
49 }
50
51
52compileShader :: ShaderDesc -> Game RenderCoreState Shader
53compileShader (ShaderDesc shaderType source defines) = do
54 code <- case source of
55 ShaderFromString code -> return code
56 ShaderFromFile file -> gameIO $ readFile file
57 state <- getGameState
58 let shaderHash = hash code -- TODO: Should also include defines.
59 case HashMap.lookup shaderHash (shaders state) of
60 Just shader -> return shader
61 Nothing -> do
62 let definesString = makeDefinesString defines
63 handle <- gameIO $ glCreateShader (toGLShaderType shaderType)
64 gameIO $ withCStringLen code $ \(codeCString, codeLen) ->
65 withCStringLen definesString $ \(definesCString, definesLen) ->
66 withCStringLen header $ \(headerCString, headerLen) ->
67 withArray [headerCString, definesCString, codeCString] $ \strPtrs ->
68 withArray (fromIntegral <$> [headerLen, definesLen, codeLen] :: [GLint])
69 $ \lengths ->
70 glShaderSource handle 3 strPtrs lengths
71 err <- gameIO $ do
72 glCompileShader handle
73 alloca $ \statusPtr -> do
74 glGetShaderiv handle GL_COMPILE_STATUS statusPtr
75 result <- peek statusPtr
76 case result of
77 0 -> alloca $ \lenPtr -> do
78 glGetShaderiv handle GL_INFO_LOG_LENGTH lenPtr
79 len <- peek lenPtr
80 case len of
81 0 -> return $ Just ""
82 _ -> withCString (replicate (fromIntegral len) '\0') $ \logPtr -> do
83 glGetShaderInfoLog handle len nullPtr logPtr
84 Just <$> peekCString logPtr
85 _ -> return Nothing
86 case err of
87 Nothing -> do
88 resourceKey <- register $ deleteShader' handle
89 let shader = Shader handle resourceKey shaderType shaderHash
90 saveGameState $ state {
91 shaders = HashMap.insert shaderHash shader (shaders state)
92 }
93 return shader
94 Just err -> gameError $
95 "Failed to compile shader: [" ++ show source ++ "]: " ++ err
96
97compileShaderProgram :: [Shader] -> Game RenderCoreState ShaderProgram
98compileShaderProgram shaders = do
99 state <- getGameState
100 let programHash = hashShaders shaders
101 case HashMap.lookup programHash (shaderPrograms state) of
102 Just program -> return program
103 Nothing -> do
104 handle <- gameIO glCreateProgram
105 case handle of
106 0 -> gameError "Failed to create shader program"
107 _ -> do
108 mapM_ (gameIO . glAttachShader handle) (shaderHandle <$> shaders)
109 err <- gameIO $ do
110 glLinkProgram handle
111 alloca $ \statusPtr -> do
112 glGetProgramiv handle GL_LINK_STATUS statusPtr
113 status <- peek statusPtr
114 case status of
115 0 -> alloca $ \lenPtr -> do
116 glGetShaderiv handle GL_INFO_LOG_LENGTH lenPtr
117 len <- peek lenPtr
118 case len of
119 0 -> return $ Just "Unknown error"
120 _ -> withCString (replicate (fromIntegral len) '\0') $ \logPtr -> do
121 glGetShaderInfoLog handle len nullPtr logPtr
122 Just <$> peekCString logPtr
123 _ -> return Nothing
124 case err of
125 Nothing -> do
126 resourceKey <- register $ deleteShaderProgram' handle
127 uniforms <- gameIO $ newIORef []
128 let program = ShaderProgram handle resourceKey programHash uniforms
129 saveGameState $ state {
130 shaderPrograms = HashMap.insert programHash program (shaderPrograms state)
131 }
132 return program
133 Just err -> gameError $
134 "Failed to compile shader program: " ++ err ++ "; shaders: " ++
135 intercalate ", " (show . shaderHandle <$> shaders)
136
137deleteShader :: Shader -> Game RenderCoreState ()
138deleteShader shader = do
139 modifyGameState (\state -> state {
140 shaders = HashMap.delete (shaderHash shader) (shaders state) })
141 release shader
142
143deleteShaderProgram :: ShaderProgram -> Game RenderCoreState ()
144deleteShaderProgram program = do
145 modifyGameState (\state -> state {
146 shaderPrograms = HashMap.delete (shaderProgramHash program) (shaderPrograms state)})
147 release program
148
149activateShaderProgram :: ShaderProgram -> IO ()
150activateShaderProgram program = do
151 glUseProgram . shaderProgramHandle $ program
152 applyUniforms program
153
154deactivateShaderProgram :: ShaderProgram -> IO ()
155deactivateShaderProgram _ = glUseProgram 0
156
157setUniform :: ShaderUniform -> ShaderProgram -> IO ()
158setUniform uniform program =
159 modifyIORef (shaderProgramUniforms program) (setUniform' . removeUniform)
160 where removeUniform = deleteBy matchesUniform uniform
161 matchesUniform uniform u = uniformName u == uniformName uniform
162 setUniform' = (:) uniform
163
164applyUniforms :: ShaderProgram -> IO ()
165applyUniforms program =
166 let update (FloatUniform name value) =
167 glGetUniformLocation' handle name >>=
168 \location -> glUniform1f (fromIntegral location) value
169 update (Vec3Uniform name (Vector3 x y z)) =
170 glGetUniformLocation' handle name >>=
171 \location -> glUniform3f (fromIntegral location) x y z
172 update (Vec4Uniform name (Vector4 x y z w)) =
173 glGetUniformLocation' handle name >>=
174 \location -> glUniform4f (fromIntegral location) x y z w
175 update (Mat4Uniform name mat4) =
176 glGetUniformLocation' handle name >>=
177 \location -> with mat4 $ \ptrMat4 ->
178 glUniformMatrix4fv location 1 GL_FALSE (unsafeCoerce ptrMat4)
179 update (Mat4ArrayUniform name mat4s) =
180 glGetUniformLocation' handle name >>=
181 \location -> withArray mat4s $ \ptrMat4s ->
182 glUniformMatrix4fv location (fromIntegral $ length mat4s) GL_FALSE (unsafeCoerce ptrMat4s)
183 handle = shaderProgramHandle program
184 in do
185 uniforms <- readIORef (shaderProgramUniforms program)
186 mapM_ update uniforms
187 writeIORef (shaderProgramUniforms program) []
188
189-- Private
190
191glGetUniformLocation' :: GLuint -> String -> IO GLint
192glGetUniformLocation' handle name =
193 withCString name $ \nameCStr ->
194 glGetUniformLocation (fromIntegral handle) (unsafeCoerce nameCStr)
195
196deleteShader' :: GLuint -> IO ()
197deleteShader' = glDeleteShader
198
199deleteShaderProgram' :: GLuint -> IO ()
200deleteShaderProgram' = glDeleteProgram
201
202hashShaders :: [Shader] -> Int
203hashShaders = foldl' hashF 0
204 where hashF hash shader = (hash `shiftL` 32) .|. fromIntegral (shaderHandle shader)
205
206toGLShaderType :: ShaderType -> GLenum
207toGLShaderType VertexShader = GL_VERTEX_SHADER
208toGLShaderType FragmentShader = GL_FRAGMENT_SHADER
209toGLShaderType ComputeShader = GL_COMPUTE_SHADER
210
211makeDefinesString :: [Define] -> String
212makeDefinesString defines = intercalate "\n" body ++ "\n"
213 where body = (\(name, value) -> "#define " ++ name ++ " " ++ value) <$> defines
214
215-- Header prepended to all shaders.
216header = "#version 400 core\n"
diff --git a/Spear/Render/Core/State.hs b/Spear/Render/Core/State.hs
new file mode 100644
index 0000000..34b0732
--- /dev/null
+++ b/Spear/Render/Core/State.hs
@@ -0,0 +1,157 @@
1module Spear.Render.Core.State where
2
3import Spear.Game
4import Spear.Math.Matrix4
5import Spear.Math.Vector
6
7import Data.HashMap as HashMap
8import Data.IORef
9import Data.Word
10import Graphics.GL.Core46
11
12
13
14data BufferType
15 = BufferUntyped
16 | Buffer2d
17 | Buffer3d
18 | Buffer4d
19 | BufferFloat
20 | BufferU8
21 | BufferU16
22
23data BufferUsage
24 = BufferStatic
25 | BufferDynamic
26
27-- | A data buffer (e.g., vertex attributes, indices).
28data Buffer = Buffer
29 { bufferHandle :: GLuint
30 , bufferResource :: Resource
31 , bufferType :: BufferType
32 , bufferUsage :: BufferUsage
33 }
34
35-- | A buffer view.
36data BufferView a = BufferView
37 { bufferViewBuffer :: Buffer
38 , bufferViewOffsetBytes :: GLuint
39 , bufferViewSizeBytes :: GLuint
40 , bufferViewStrideBytes :: GLsizei
41 }
42
43
44data Positions
45 = Positions2d (BufferView Vector2)
46 | Positions3d (BufferView Vector3)
47
48data Joints
49 = JointsU8 (BufferView Word8)
50 | JointsU16 (BufferView Word16)
51
52data Weights
53 = WeightsU8 (BufferView Word8)
54 | WeightsU16 (BufferView Word16)
55 | WeightsFloat (BufferView Float)
56
57data Indices
58 = IndicesU8 (BufferView Word8)
59 | IndicesU16 (BufferView Word16)
60
61data PrimitiveType
62 = Triangles
63 | TriangleFan
64 | TriangleStrip
65
66-- | A geometry descriptor.
67data GeometryDesc = GeometryDesc
68 { positions :: Maybe Positions -- Convenient for the empty descriptor.
69 , normals :: Maybe (BufferView Vector3)
70 , tangents :: Maybe (BufferView Vector4)
71 , texcoords :: Maybe (BufferView Vector4)
72 , joints :: Maybe Joints
73 , weights :: Maybe Weights
74 , indices :: Maybe Indices
75 , numVerts :: GLsizei
76 , numIndices :: GLsizei
77 , primitiveType :: PrimitiveType
78 }
79
80-- | A piece of renderable geometry.
81--
82-- Since dynamic geometry can be mutated, the descriptor is stored as an IORef
83-- so that its state cannot become stale after an update.
84data Geometry = Geometry
85 { geometryVao :: GLuint
86 , geometryResource :: Resource
87 , geometryDesc :: IORef GeometryDesc
88 }
89
90
91-- | A shader.
92data Shader = Shader
93 { shaderHandle :: GLuint
94 , shaderResource :: Resource
95 , shaderType :: ShaderType
96 , shaderHash :: Int
97 }
98
99data ShaderType
100 = VertexShader
101 | FragmentShader
102 | ComputeShader
103 deriving (Eq, Show)
104
105-- | A shader uniform.
106data ShaderUniform
107 = FloatUniform { uniformName :: String, uniformFloat :: Float }
108 | Vec3Uniform { uniformName :: String, uniformVec3 :: Vector3 }
109 | Vec4Uniform { uniformName :: String, uniformVec4 :: Vector4 }
110 | Mat4Uniform { uniformName :: String, uniformMat4 :: Matrix4 }
111 | Mat4ArrayUniform { uniformName :: String, uniformMat4s :: [Matrix4] }
112
113-- | A shader program.
114data ShaderProgram = ShaderProgram
115 { shaderProgramHandle :: GLuint
116 , shaderProgramResource :: Resource
117 , shaderProgramHash :: Int
118 -- Dirty set of uniforms that have been set since the last time uniforms were
119 -- applied. OpenGL retains the values of uniforms for a program until the
120 -- program is linked again, so we only need to store the updates here.
121 , shaderProgramUniforms :: IORef [ShaderUniform]
122 }
123
124
125-- | Core render state.
126data RenderCoreState = RenderCoreState
127 { buffers :: Map GLuint Buffer
128 , geometries :: Map GLuint Geometry
129 , shaders :: Map ShaderHash Shader
130 , shaderPrograms :: Map ShaderProgramHash ShaderProgram
131 }
132
133type ShaderHash = Int
134type ShaderProgramHash = Int
135
136
137
138instance ResourceClass Buffer where
139 getResource = bufferResource
140
141instance ResourceClass Geometry where
142 getResource = geometryResource
143
144instance ResourceClass Shader where
145 getResource = shaderResource
146
147instance ResourceClass ShaderProgram where
148 getResource = shaderProgramResource
149
150
151newRenderCoreState :: RenderCoreState
152newRenderCoreState = RenderCoreState
153 { buffers = HashMap.empty
154 , geometries = HashMap.empty
155 , shaders = HashMap.empty
156 , shaderPrograms = HashMap.empty
157 }
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-23 09:50:37 +0000