diff --git a/renderer-tutorial.cabal b/renderer-tutorial.cabal index 4c298c2..d3f47ab 100644 --- a/renderer-tutorial.cabal +++ b/renderer-tutorial.cabal @@ -44,5 +44,6 @@ executable renderer-tutorial , Scenes.SceneClass , Scenes.ClearColor , Scenes.Texture2D + , Scenes.Texture2DBatched hs-source-dirs: src default-language: Haskell2010 diff --git a/res/shaders/fragbatch.shader b/res/shaders/fragbatch.shader new file mode 100644 index 0000000..29d9a95 --- /dev/null +++ b/res/shaders/fragbatch.shader @@ -0,0 +1,16 @@ +#version 330 core + +layout(location = 0) out vec4 color; + +in vec4 v_color; +in vec2 v_texCoord; +in float v_texIndex; + +uniform sampler2D u_textures[2]; + +void main() +{ + //vec4 texColor = texture(u_texture, v_texCoord); + int index = int(v_texIndex); + color = texture(u_textures[index], v_texCoord); +} diff --git a/res/shaders/vertbatch.shader b/res/shaders/vertbatch.shader new file mode 100644 index 0000000..7c44638 --- /dev/null +++ b/res/shaders/vertbatch.shader @@ -0,0 +1,20 @@ +#version 330 core + +layout(location = 0) in vec3 a_position; +layout(location = 1) in vec4 a_color; +layout(location = 2) in vec2 a_texCoord; +layout(location = 3) in float a_texIndex; + +out vec4 v_color; +out vec2 v_texCoord; +out float v_texIndex; + +uniform mat4 u_mvp; + +void main() +{ + gl_Position = u_mvp * vec4(a_position, 1); + v_texCoord = a_texCoord; + v_color = a_color; + v_texIndex = a_texIndex; +} diff --git a/res/textures/brainbulb_on.flat.png b/res/textures/brainbulb_on.flat.png new file mode 100644 index 0000000..df264a7 Binary files /dev/null and b/res/textures/brainbulb_on.flat.png differ diff --git a/src/Main.hs b/src/Main.hs index d1e93b3..e7e2e52 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -44,6 +44,7 @@ import EventHandler import Scenes.SceneClass import Scenes.ClearColor import Scenes.Texture2D +import Scenes.Texture2DBatched main :: IO () main = do @@ -171,6 +172,10 @@ sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs isEmpty <- isEmptyMVar curScene when isEmpty $ do putMVar curScene =<< fmap Scene (initScene @Texture2D) + SDL.KeycodeF3 -> do + isEmpty <- isEmptyMVar curScene + when isEmpty $ do + putMVar curScene =<< fmap Scene (initScene @Texture2DBatched) _ -> return () switch _ = return () diff --git a/src/Scenes/Texture2D.hs b/src/Scenes/Texture2D.hs index e082977..0e8503a 100644 --- a/src/Scenes/Texture2D.hs +++ b/src/Scenes/Texture2D.hs @@ -14,6 +14,8 @@ import Linear import qualified Control.Lens as Lens +import Foreign.Storable (sizeOf) + -- internal imports import BindableClass @@ -79,10 +81,21 @@ instance SceneClass Texture2D where -- enable and specify data layout of the in-memory vertices layout <- newVertexBufferLayout + (fromIntegral $ 5 * sizeOf (undefined :: GL.GLfloat)) -- push vertex positions - pushElements layout GL.Float 3 + pushElements + layout + 0 + GL.Float + 3 + (0 * (sizeOf (undefined :: GL.GLfloat))) -- pusht texture coordinates - pushElements layout GL.Float 2 + pushElements + layout + 1 + GL.Float + 2 + (3 * (sizeOf (undefined :: GL.GLfloat))) addBuffer va vbo layout diff --git a/src/Scenes/Texture2DBatched.hs b/src/Scenes/Texture2DBatched.hs new file mode 100644 index 0000000..d9e3d72 --- /dev/null +++ b/src/Scenes/Texture2DBatched.hs @@ -0,0 +1,224 @@ +module Scenes.Texture2DBatched where + +import SDL (($=), get) +import qualified SDL +import qualified SDL.Internal.Numbered as SDL + +import qualified Graphics.Rendering.OpenGL as GL + +import qualified Graphics.GL.Functions as GLRaw + +import Control.Monad + +import Control.Concurrent.MVar + +import Linear + +import qualified Control.Lens as Lens + +import Foreign.Storable (sizeOf) + +-- internal imports + +import BindableClass +import BufferClass +import VertexArray +import VertexBuffer +import IndexBuffer +import Shader +import Renderer +import Texture + +import Scenes.SceneClass + +data Texture2DBatched = Texture2DBatched + { texModels :: MVar (M44 GL.GLfloat) + , texView :: MVar (M44 GL.GLfloat) + , texProj :: MVar (M44 GL.GLfloat) + , texVertArrObj :: GL.VertexArrayObject + , texVertArray :: VertexArray + , texIdxBUfObj :: IndexBuffer GL.GLuint + , texShaderProg :: Shader + } + +instance SceneClass Texture2DBatched where + + initScene = do + -- -- MATRICES + + let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat + mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0) + mmodel = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 400 400 0) + + vao <- GL.genObjectName + va <- newVertexArray + + GL.bindVertexArrayObject $= Just vao + + -- define vertices (positions of the rectangle corners) as List of Floats + -- with added in texture coordinates + let vertexPositions = + -- 3D positions | VertexColor | tex coords | tex indx + [ -67, -100, 0, 0.9, 0.8, 0, 1, 0, 0, 0 + , 67, -100, 0, 0.9, 0.8, 0, 1, 1, 0, 0 + , 67, 100, 0, 0.9, 0.8, 0, 1, 1, 1, 0 + , -67, 100, 0, 0.9, 0.8, 0, 1, 0, 1, 0 + + , 133, -100, 0, 0, 0.5, 0.9, 1, 0, 0, 1 + , 267, -100, 0, 0, 0.5, 0.9, 1, 1, 0, 1 + , 267, 100, 0, 0, 0.5, 0.9, 1, 1, 1, 1 + , 133, 100, 0, 0, 0.5, 0.9, 1, 0, 1, 1 + ] :: [GL.GLfloat] + + -- create draw order indices + indices = [0, 1, 2, 2, 3, 0, 4, 5, 6, 6, 7, 4] :: [GL.GLuint] + + ibo <- newIndexBuffer indices + + GL.blend $= GL.Enabled + GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) + + -- construct new VertexBuffer and fill it with data + vbo <- newVertexBuffer vertexPositions + + -- rebind the vertex buffer + bind vbo + + -- enable and specify data layout of the in-memory vertices + layout <- newVertexBufferLayout + (fromIntegral $ 10 * sizeOf (undefined :: GL.GLfloat)) + -- push vertex positions + pushElements + layout + 0 + GL.Float + 3 + (0 * (sizeOf (undefined :: GL.GLfloat))) + -- push vertex colors + pushElements + layout + 1 + GL.Float + 4 + (3 * (sizeOf (undefined :: GL.GLfloat))) + -- pusht texture coordinates + pushElements + layout + 2 + GL.Float + 2 + (7 * (sizeOf (undefined :: GL.GLfloat))) + -- pusht texture index + pushElements + layout + 3 + GL.Float + 1 + (9 * (sizeOf (undefined :: GL.GLfloat))) + + addBuffer va vbo layout + + -- -- TEXTURE + + -- generate and bind texture + tex1 <- newTexture "res/textures/lynx.jpg" 0 + tex2 <- newTexture "res/textures/brainbulb_on.flat.png" 1 + bind tex1 + bind tex2 + + -- -- tell the shader where to find the texture + sp <- newShader + [ ShaderSource GL.VertexShader "./res/shaders/vertbatch.shader" + , ShaderSource GL.FragmentShader "./res/shaders/fragbatch.shader" + ] + bind sp + -- setUniform sp "u_texture" (texSlot tex) + + -- unbind everything again + setUniformList sp "u_textures" [0 :: GL.GLint, 1] + + unbind va + unbind vbo + unbind ibo + unbind sp + + -- store the mtrices for later adjustments + proj <- newMVar mproj + view <- newMVar mview + model <- newMVar mmodel + + return $ Texture2DBatched model view proj vao va ibo sp + + update _ _ = return () + + onEvents (Texture2DBatched model view proj vao va ibo sp) evs = do + -- modify the mvars based on keystrokes + moveObj proj view model evs + + render (Texture2DBatched model view proj vao va ibo sp) = do + -- retrieve matrices from MVars + mproj <- readMVar proj + mview <- readMVar view + + GL.clearColor $= GL.Color4 0 0 0 1 + clear + mmodel <- readMVar model + bind sp + setUniform sp "u_mvp" (mproj !*! mview !*! mmodel) + + -- the actual drawing happens here + draw va ibo sp + +moveObj + :: MVar (M44 GL.GLfloat) + -> MVar (M44 GL.GLfloat) + -> MVar (M44 GL.GLfloat) + -> [SDL.Event] + -> IO () +moveObj proj view model evs = + modifyMVar_ proj (\mproj -> do + modifyMVar_ view (\mview -> do + modifyMVar_ model (\mmodel -> do + let plusModel = foldl (\acc ev -> case SDL.eventPayload ev of + (SDL.KeyboardEvent + ( SDL.KeyboardEventData + _ + SDL.Pressed + _ + (SDL.Keysym _ code mod) + )) + -> + let trans = + mkTransformationMat + (identity :: M33 GL.GLfloat) + ( ( if SDL.keyModifierLeftShift mod + then (-1) + else 1 + ) + * + ( case code of + SDL.KeycodeX -> + V3 1 0 0 + SDL.KeycodeY -> + V3 0 1 0 + _ -> + V3 0 0 0 + ) + ) + !-! + (identity :: M44 GL.GLfloat) + in acc !+! trans + _ -> acc + ) + zero + evs + let retval = mmodel !+! plusModel + when (not $ plusModel == zero) $ + print ("Current Position of object: " <> + show (Lens.view translation $ retval)) + return retval + ) + return mview + ) + return mproj + ) diff --git a/src/Shader.hs b/src/Shader.hs index 81601cb..0d1c505 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -21,6 +21,8 @@ import Control.Concurrent.MVar import Linear import Foreign.Marshal.Utils (with) +import Foreign.Marshal.Array (withArray) +import Foreign.Storable import Foreign.Ptr -- internal imports @@ -116,6 +118,37 @@ newShader shaderSrc = do Shader program shaderSrc <$> newMVar [] -- pass uniform values into Shader program +setUniformList :: (Storable a, GL.Uniform a) => Shader -> String -> [a] -> IO () +setUniformList (Shader shaderProgram _ shaderUniforms) uniname data_ = do + -- check if uniform location is already cached + locs <- readMVar shaderUniforms + + -- retrieve uniform location + 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 + withArray data_ $ \ptr -> + GL.uniformv loc (fromIntegral $ length data_) ptr + --GL.uniform loc $= data_ + -- add uniform to cache + modifyMVar_ shaderUniforms + (\list -> return $ ShaderUniform uniname loc : list) + [ShaderUniform _ loc] -> + -- set the data + withArray data_ $ \ptr -> + GL.uniformv loc (fromIntegral $ length data_) ptr + setUniform :: (GL.Uniform a) => Shader -> String -> a -> IO () setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do -- check if uniform location is already cached @@ -136,6 +169,8 @@ setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do print ("Uniform does not exist in shader program: " <> uniname) else do -- set the data + --withArray data_ $ \ptr -> + -- GL.uniformv loc (length data_) ptr GL.uniform loc $= data_ -- add uniform to cache modifyMVar_ shaderUniforms diff --git a/src/Texture.hs b/src/Texture.hs index 6df81ae..3efba31 100644 --- a/src/Texture.hs +++ b/src/Texture.hs @@ -23,10 +23,10 @@ import BindableClass data Texture = Texture { texId :: GL.TextureObject , texSlot :: GL.TextureUnit - , texPath :: FilePath - , texDimensions :: V2 GL.GLsizei - , texBPP :: Int - , texData :: Ptr () + -- , texPath :: FilePath + -- , texDimensions :: V2 GL.GLsizei + -- , texBPP :: Int + -- , texData :: Ptr () } instance Bindable Texture where @@ -51,10 +51,10 @@ newTexture fp slot = do tex <- Texture <$> GL.genObjectName <*> (pure $ GL.TextureUnit slot) - <*> (pure fp) - <*> (pure $ fmap fromIntegral $ V2 (imageWidth img) (imageHeight img)) - <*> (pure $ componentCount (VS.head $ imageData img)) - <*> (pure $ castPtr ptr) + -- <*> (pure fp) + let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img) + -- <*> (pure $ componentCount (VS.head $ imageData img)) + data_ = castPtr ptr -- bind texture bind tex @@ -65,7 +65,7 @@ newTexture fp slot = do GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp) -- put data into GPU memory - loadTexture tex + loadTexture tex dimensions data_ -- unbind texture unbind tex @@ -76,9 +76,9 @@ newTexture fp slot = do -- pass texture object out return tex -loadTexture :: Texture -> IO () -loadTexture tex = - let (V2 w h) = texDimensions tex +loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO () +loadTexture tex dimensions data_ = + let (V2 w h) = dimensions in GL.texImage2D GL.Texture2D GL.NoProxy @@ -86,4 +86,4 @@ loadTexture tex = GL.RGBA' (GL.TextureSize2D w h) 0 - (GL.PixelData GL.RGBA GL.UnsignedByte (texData tex)) + (GL.PixelData GL.RGBA GL.UnsignedByte data_) diff --git a/src/VertexArray.hs b/src/VertexArray.hs index 3b08bc6..a9d8f34 100644 --- a/src/VertexArray.hs +++ b/src/VertexArray.hs @@ -52,51 +52,64 @@ addBuffer va vb layout = do bind vb -- enable and fill out the vertex attrib pointer(s) list <- readMVar (vblElements layout) - let indexed = zip [0 ..] list - dataElementSize e = case e of + let dataElementSize e = case e of GL.Float -> sizeOf (undefined :: GL.GLfloat) x -> error ("No size computation implemented fof: " <> show x) mapM_ - (\(index, elem) -> do - let offset = fromIntegral $ - foldl - (\acc (index, elem) -> acc + vbleCount elem) - 0 - (filter ((< index) . fst) indexed) :: Int - GL.vertexAttribArray (GL.AttribLocation $ fromIntegral index) $= + (\(VertexBufferLayoutElement index type_ count offset handling) -> do + GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled - GL.vertexAttribPointer (GL.AttribLocation $ fromIntegral index) $= - ( vbleHandling elem + GL.vertexAttribPointer (GL.AttribLocation index) $= + ( handling , GL.VertexArrayDescriptor -- number of components to our attribute - (vbleCount elem) + count -- datatype of elements - (vbleType elem) - -- ??? - (sum (map vbleCount list) * fromIntegral (dataElementSize (vbleType elem))) - -- offset from beginnning of vertex - (plusPtr nullPtr (offset * dataElementSize (vbleType elem))) + type_ + -- Stride (How big is one Vertex in bytes) + (vblStride layout) + -- offset from beginnning of vertex in bytes + (plusPtr nullPtr offset) ) ) - indexed + list unbind va unbind vb -newtype VertexBufferLayout = VertexBufferLayout +data VertexBufferLayout = VertexBufferLayout { vblElements :: MVar [VertexBufferLayoutElement] + , vblStride :: GL.GLsizei } data VertexBufferLayoutElement = VertexBufferLayoutElement - { vbleType :: GL.DataType + { vbleIndex :: GL.GLuint + , vbleType :: GL.DataType , vbleCount :: GL.GLint + , vbleOffset :: Int , vbleHandling :: GL.IntegerHandling } -newVertexBufferLayout :: IO VertexBufferLayout -newVertexBufferLayout = VertexBufferLayout +newVertexBufferLayout :: GL.GLsizei -> IO VertexBufferLayout +newVertexBufferLayout stride = VertexBufferLayout <$> newMVar [] + <*> pure stride -pushElements :: VertexBufferLayout -> GL.DataType -> GL.GLint -> IO () -pushElements vbl type_ count = do +pushElements + :: VertexBufferLayout + -> GL.GLuint + -> GL.DataType + -> GL.GLint + -> Int + -> IO () +pushElements vbl index type_ count offset = do modifyMVar_ (vblElements vbl) $ \list -> - return (list ++ [VertexBufferLayoutElement type_ count GL.ToNormalizedFloat]) + return + (list ++ + [VertexBufferLayoutElement + index + type_ + count + offset + GL.ToNormalizedFloat + ] + )