finished episode 31

This commit is contained in:
nek0 2020-08-29 22:13:25 +02:00
parent 4f414f1410
commit 102ff2ec77
7 changed files with 307 additions and 5 deletions

View file

@ -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.

View file

@ -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

View file

@ -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;

View file

@ -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 ()

View file

@ -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

View file

@ -42,8 +42,9 @@ newVertexArray = VertexArray
<$> GL.genObjectName
addBuffer
:: VertexArray
-> VertexBuffer a
:: (Buffer buf)
=> VertexArray
-> buf
-> VertexBufferLayout
-> IO ()
addBuffer va vb layout = do

View file

@ -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