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