181 lines
4.8 KiB
Haskell
181 lines
4.8 KiB
Haskell
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
|