finished episode 31
This commit is contained in:
parent
4f414f1410
commit
102ff2ec77
7 changed files with 307 additions and 5 deletions
10
README.md
10
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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
17
src/Main.hs
17
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 ()
|
||||
|
|
180
src/Scenes/Texture2DBatchedDynamic.hs
Normal file
180
src/Scenes/Texture2DBatchedDynamic.hs
Normal 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
|
|
@ -42,8 +42,9 @@ newVertexArray = VertexArray
|
|||
<$> GL.genObjectName
|
||||
|
||||
addBuffer
|
||||
:: VertexArray
|
||||
-> VertexBuffer a
|
||||
:: (Buffer buf)
|
||||
=> VertexArray
|
||||
-> buf
|
||||
-> VertexBufferLayout
|
||||
-> IO ()
|
||||
addBuffer va vb layout = do
|
||||
|
|
93
src/VertexBufferDynamic.hs
Normal file
93
src/VertexBufferDynamic.hs
Normal 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
|
Loading…
Reference in a new issue