finished episode 27

This commit is contained in:
nek0 2020-08-29 10:01:04 +02:00
parent 8f5ea5531c
commit 74387cf18b
2 changed files with 31 additions and 23 deletions

View file

@ -97,10 +97,6 @@ instance SceneClass Texture2D where
[ ShaderSource GL.VertexShader "./res/shaders/vert.shader" [ ShaderSource GL.VertexShader "./res/shaders/vert.shader"
, ShaderSource GL.FragmentShader "./res/shaders/frag.shader" , ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
] ]
[ "u_color"
, "u_texture"
, "u_mvp"
]
bind sp bind sp
setUniform sp "u_texture" (texSlot tex) setUniform sp "u_texture" (texSlot tex)

View file

@ -16,6 +16,8 @@ import qualified Data.ByteString as B
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Control.Concurrent.MVar
import Linear import Linear
import Foreign.Marshal.Utils (with) import Foreign.Marshal.Utils (with)
@ -28,7 +30,7 @@ import BindableClass
data Shader = Shader data Shader = Shader
{ shaderId :: GL.Program { shaderId :: GL.Program
, shaderSources :: [ShaderSource] , shaderSources :: [ShaderSource]
, shaderUniforms :: [ShaderUniform] , shaderUniforms :: MVar [ShaderUniform]
} }
-- make Shader Bindable -- make Shader Bindable
@ -75,8 +77,8 @@ isRowMajor :: GL.MatrixOrder -> GL.GLboolean
isRowMajor p = if (GL.RowMajor == p) then 1 else 0 isRowMajor p = if (GL.RowMajor == p) then 1 else 0
-- create new data object of type Shader -- create new data object of type Shader
newShader :: [ShaderSource] -> [String] -> IO Shader newShader :: [ShaderSource] -> IO Shader
newShader shaderSrc uniforms = do newShader shaderSrc = do
-- create program Object -- create program Object
program <- GL.createProgram program <- GL.createProgram
@ -110,27 +112,37 @@ newShader shaderSrc uniforms = do
-- throw away the shaders, since they are linked into the shader program -- throw away the shaders, since they are linked into the shader program
mapM_ (\s -> GL.deleteObjectName s) (map snd compilates) mapM_ (\s -> GL.deleteObjectName s) (map snd compilates)
-- retrieve locations of all uniforms and store them
uniLocs <- mapM
(\name -> do
loc <- get $ GL.uniformLocation program name
return (ShaderUniform name loc)
)
uniforms
-- return data object -- return data object
return (Shader program shaderSrc uniLocs) Shader program shaderSrc <$> newMVar []
-- pass uniform values into Shader program -- pass uniform values into Shader program
setUniform :: (GL.Uniform a) => Shader -> String -> a -> IO () setUniform :: (GL.Uniform a) => Shader -> String -> a -> IO ()
setUniform shader uniname data_ = do setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do
-- retrieve uniform location -- check if uniform location is already cached
let [ShaderUniform _ loc] = filter locs <- readMVar shaderUniforms
(\(ShaderUniform name _) -> name == uniname)
(shaderUniforms shader)
-- set the data -- retrieve uniform location
GL.uniform loc $= data_ let unilocs = filter
(\(ShaderUniform name _) -> name == uniname)
locs
case unilocs of
[] -> do
print ("Unknown uniform: " <> uniname)
print "Retrieving uniform location from shader program"
loc@(GL.UniformLocation locNum) <- get $ GL.uniformLocation shaderProgram uniname
if locNum < 0
then
print ("Uniform does not exist in shader program: " <> uniname)
else do
-- set the data
GL.uniform loc $= data_
-- add uniform to cache
modifyMVar_ shaderUniforms
(\list -> return $ ShaderUniform uniname loc : list)
[ShaderUniform _ loc] ->
-- set the data
GL.uniform loc $= data_
-- | compile a shader from source -- | compile a shader from source
compileShaderSource compileShaderSource