diff --git a/README.md b/README.md index ff565ab..4027115 100644 --- a/README.md +++ b/README.md @@ -37,3 +37,13 @@ background colour. Press `Left Shift` and the number key to decrease it. Use keys `1` and `2` to switch between the textured quads, move them forward on the x and y axis by pressing `X` and `Y` respectively or backward using `Left Shift` and the appropriate key. + +## `F3` - Textured quads batched statically + +Move the quads forward on +the x and y axis by pressing `X` and `Y` respectively or backward using +`Left Shift` and the appropriate key. + +## `F4` - Textured quads batched dynamically + +No interaction. diff --git a/renderer-tutorial.cabal b/renderer-tutorial.cabal index d3f47ab..2074c14 100644 --- a/renderer-tutorial.cabal +++ b/renderer-tutorial.cabal @@ -32,9 +32,11 @@ executable renderer-tutorial , JuicyPixels-extra , StateVar , lens + , clock other-modules: BindableClass , BufferClass , VertexBuffer + , VertexBufferDynamic , VertexArray , IndexBuffer , Shader @@ -45,5 +47,6 @@ executable renderer-tutorial , Scenes.ClearColor , Scenes.Texture2D , Scenes.Texture2DBatched + , Scenes.Texture2DBatchedDynamic hs-source-dirs: src default-language: Haskell2010 diff --git a/shell.nix b/shell.nix index 8711563..18d3776 100644 --- a/shell.nix +++ b/shell.nix @@ -4,7 +4,7 @@ let inherit (nixpkgs) pkgs; - f = { mkDerivation, base, bytestring, JuicyPixels + f = { mkDerivation, base, bytestring, clock, JuicyPixels , JuicyPixels-extra, lens, linear, monad-loops, OpenGL, OpenGLRaw , random, sdl2, StateVar, stdenv, vector }: @@ -15,7 +15,7 @@ let isLibrary = false; isExecutable = true; executableHaskellDepends = [ - base bytestring JuicyPixels JuicyPixels-extra lens linear + base bytestring clock JuicyPixels JuicyPixels-extra lens linear monad-loops OpenGL OpenGLRaw random sdl2 StateVar vector ]; license = stdenv.lib.licenses.gpl3; diff --git a/src/Main.hs b/src/Main.hs index e7e2e52..695bdb0 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -31,6 +31,8 @@ import qualified Data.List as L import System.Random (randomRIO) +import System.Clock + import Linear -- internal imports @@ -45,6 +47,7 @@ import Scenes.SceneClass import Scenes.ClearColor import Scenes.Texture2D import Scenes.Texture2DBatched +import Scenes.Texture2DBatchedDynamic main :: IO () main = do @@ -94,6 +97,9 @@ main = do -- initial poll for events evs <- newMVar =<< SDL.pollEvents + -- time container for dt + time <- newMVar =<< getTime Monotonic + -- Loop running until window closes whileM_ (notElem (SDL.WindowClosedEvent (SDL.WindowClosedEventData window)) <$> map SDL.eventPayload <$> readMVar evs) $ do @@ -113,10 +119,15 @@ main = do hasSelect <- not <$> isEmptyMVar curScene if hasSelect then do + now <- getTime Monotonic + before <- readMVar time + let dt = fromIntegral + (toNanoSecs $ diffTimeSpec before now) / (10 ^ (9 :: Int)) (Scene sceneObject) <- readMVar curScene onEvents sceneObject currentEvents - update sceneObject 0 + update sceneObject dt render sceneObject + void $ swapMVar time now else do GL.clearColor $= GL.Color4 0 0 0 1 GL.clear [GL.ColorBuffer] @@ -176,6 +187,10 @@ sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs isEmpty <- isEmptyMVar curScene when isEmpty $ do putMVar curScene =<< fmap Scene (initScene @Texture2DBatched) + SDL.KeycodeF4 -> do + isEmpty <- isEmptyMVar curScene + when isEmpty $ do + putMVar curScene =<< fmap Scene (initScene @Texture2DBatchedDynamic) _ -> return () switch _ = return () diff --git a/src/Scenes/Texture2DBatchedDynamic.hs b/src/Scenes/Texture2DBatchedDynamic.hs new file mode 100644 index 0000000..64e2fcc --- /dev/null +++ b/src/Scenes/Texture2DBatchedDynamic.hs @@ -0,0 +1,180 @@ +module Scenes.Texture2DBatchedDynamic 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 +import Foreign.C.Types + +import Foreign.Marshal.Array (withArray) + +-- internal imports + +import BindableClass +import BufferClass +import VertexArray +import VertexBufferDynamic +import IndexBuffer +import Shader +import Renderer +import Texture + +import Scenes.SceneClass + +data Texture2DBatchedDynamic = Texture2DBatchedDynamic + { texModels :: MVar (M44 GL.GLfloat) + , texView :: MVar (M44 GL.GLfloat) + , texProj :: MVar (M44 GL.GLfloat) + , texVertArrObj :: GL.VertexArrayObject + , texVertArray :: VertexArray + , texVertBuf :: VertexBufferDynamic + , texIdxBufObj :: IndexBuffer GL.GLuint + , texShaderProg :: Shader + } + +instance SceneClass Texture2DBatchedDynamic 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 0 0 0) + + vao <- GL.genObjectName + va <- newVertexArray + + GL.bindVertexArrayObject $= Just vao + + -- create draw order indices + let 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 <- newVertexBufferDynamic + + -- 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] + setUniform sp "u_mvp" (mproj !*! mview !*! mmodel) + + unbind va + unbind vbo + unbind ibo + unbind sp + + -- store the mtrices for later adjustments + proj <- newMVar mproj + view <- newMVar mview + model <- newMVar mmodel + + return $ Texture2DBatchedDynamic model view proj vao va vbo ibo sp + + update (Texture2DBatchedDynamic _ _ _ vao _ vbo _ _) dt = do + let vertices = verticesToFloatList $ createQuad (V2 (dt * 500) 500) 0 + ++ createQuad (V2 500 (dt * 500)) 1 + GL.bindVertexArrayObject $= Just vao + bind vbo + withArray vertices $ \ptr -> + GL.bufferSubData + (target vbo) -- ^ The target buffer + GL.WriteToBuffer -- ^ transfer direction + (CPtrdiff 0) -- ^ Offset of the written data in the buffer + (CPtrdiff (fromIntegral $ length vertices * sizeOf (undefined :: GL.GLfloat))) + -- ^ The size of the written data + ptr -- ^ Pointer to data + + + + onEvents _ _ = + return () + + render (Texture2DBatchedDynamic model view proj vao va _ ibo sp) = do + -- retrieve matrices from MVars + GL.clearColor $= GL.Color4 0 0 0 1 + clear + + -- the actual drawing happens here + draw va ibo sp + +createQuad :: V2 GL.GLfloat -> Int -> [Vertex] +createQuad pos@(V2 x y) index = + [ newVertex (V3 (x - 67) (y - 100) 0) (V4 0 0 0 1) (V2 0 0) (fromIntegral index) + , newVertex (V3 (x + 67) (y - 100) 0) (V4 0 0 0 1) (V2 1 0) (fromIntegral index) + , newVertex (V3 (x + 67) (y + 100) 0) (V4 0 0 0 1) (V2 1 1) (fromIntegral index) + , newVertex (V3 (x - 67) (y + 100) 0) (V4 0 0 0 1) (V2 0 1) (fromIntegral index) + ] + +verticesToFloatList :: [Vertex] -> [GL.GLfloat] +verticesToFloatList [] = [] +verticesToFloatList ((Vertex (V3 x y z) (V4 r g b a) (V2 u v) idx _):verts) = + [x, y, z, r, g, b, a, u, v, idx] ++ verticesToFloatList verts diff --git a/src/VertexArray.hs b/src/VertexArray.hs index a9d8f34..2d665ae 100644 --- a/src/VertexArray.hs +++ b/src/VertexArray.hs @@ -42,8 +42,9 @@ newVertexArray = VertexArray <$> GL.genObjectName addBuffer - :: VertexArray - -> VertexBuffer a + :: (Buffer buf) + => VertexArray + -> buf -> VertexBufferLayout -> IO () addBuffer va vb layout = do diff --git a/src/VertexBufferDynamic.hs b/src/VertexBufferDynamic.hs new file mode 100644 index 0000000..bd70149 --- /dev/null +++ b/src/VertexBufferDynamic.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE TypeFamilies #-} +module VertexBufferDynamic where + +import qualified Graphics.Rendering.OpenGL as GL + +import SDL (($=), get) + +import Linear + +import Foreign +import Foreign.C.Types + +-- internal imports + +import BindableClass +import BufferClass + +-- layout of the VertexBuffer data object +data VertexBufferDynamic = VertexBufferDynamic + { vBufId :: GL.BufferObject -- buffer id + , vBufSize :: GL.GLsizeiptr -- size of data + -- , vBufData :: Ptr a -- pointer to data + } + +data Vertex = Vertex + { vertPosition :: V3 GL.GLfloat + , vertColor :: V4 GL.GLfloat + , vertTexCoord :: V2 GL.GLfloat + , vertTexID :: GL.GLfloat + , vertSize :: GL.GLsizei + } + +-- | Smart constructor for a new Vertex +newVertex + :: V3 GL.GLfloat + -> V4 GL.GLfloat + -> V2 GL.GLfloat + -> GL.GLfloat + -> Vertex +newVertex pos color texcoord index = + Vertex + pos + color + texcoord + index + (fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat))) + +-- instanciate typeclass from BufferClass and fill in missing implementations +instance Buffer VertexBufferDynamic where + + type ObjName VertexBufferDynamic = GL.BufferObject + + target _ = GL.ArrayBuffer + + glId = vBufId + + initialize buf = do + -- bind the buffer using the default iplementation of the typeclass + bind buf + -- fill in the data + GL.bufferData (target buf) $= + ( vBufSize buf + , nullPtr + , GL.DynamicDraw + ) + -- release the buffer using the default implementation of the typeclass + unbind buf + + +instance Bindable VertexBufferDynamic where + + -- bind the buffer + bind buf = GL.bindBuffer (target buf) $= Just (glId buf) + + -- unbind the buffer + unbind buf = GL.bindBuffer (target buf) $= Nothing + +newVertexBufferDynamic + :: IO VertexBufferDynamic -- newly built VertexBuffer data object +newVertexBufferDynamic = do + let dummyVertex = newVertex (V3 0 0 0) (V4 0 0 0 0) (V2 0 0) 0 + -- create the buffer object in applicative style + buf <- VertexBufferDynamic + -- generate the ID + <$> GL.genObjectName + -- compute buffer size + <*> pure (CPtrdiff (fromIntegral $ 1024 * vertSize dummyVertex)) + -- make pointer out of list + -- <*> newArray list + -- fill the data in to the buffer + initialize buf + -- return the data object + return buf