225 lines
6.0 KiB
Haskell
225 lines
6.0 KiB
Haskell
module Scenes.Texture2DBatched 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.Storable (sizeOf)
|
|
|
|
-- internal imports
|
|
|
|
import BindableClass
|
|
import BufferClass
|
|
import VertexArray
|
|
import VertexBuffer
|
|
import IndexBuffer
|
|
import Shader
|
|
import Renderer
|
|
import Texture
|
|
|
|
import Scenes.SceneClass
|
|
|
|
data Texture2DBatched = Texture2DBatched
|
|
{ texModels :: MVar (M44 GL.GLfloat)
|
|
, texView :: MVar (M44 GL.GLfloat)
|
|
, texProj :: MVar (M44 GL.GLfloat)
|
|
, texVertArrObj :: GL.VertexArrayObject
|
|
, texVertArray :: VertexArray
|
|
, texIdxBUfObj :: IndexBuffer GL.GLuint
|
|
, texShaderProg :: Shader
|
|
}
|
|
|
|
instance SceneClass Texture2DBatched 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 400 400 0)
|
|
|
|
vao <- GL.genObjectName
|
|
va <- newVertexArray
|
|
|
|
GL.bindVertexArrayObject $= Just vao
|
|
|
|
-- define vertices (positions of the rectangle corners) as List of Floats
|
|
-- with added in texture coordinates
|
|
let vertexPositions =
|
|
-- 3D positions | VertexColor | tex coords | tex indx
|
|
[ -67, -100, 0, 0.9, 0.8, 0, 1, 0, 0, 0
|
|
, 67, -100, 0, 0.9, 0.8, 0, 1, 1, 0, 0
|
|
, 67, 100, 0, 0.9, 0.8, 0, 1, 1, 1, 0
|
|
, -67, 100, 0, 0.9, 0.8, 0, 1, 0, 1, 0
|
|
|
|
, 133, -100, 0, 0, 0.5, 0.9, 1, 0, 0, 1
|
|
, 267, -100, 0, 0, 0.5, 0.9, 1, 1, 0, 1
|
|
, 267, 100, 0, 0, 0.5, 0.9, 1, 1, 1, 1
|
|
, 133, 100, 0, 0, 0.5, 0.9, 1, 0, 1, 1
|
|
] :: [GL.GLfloat]
|
|
|
|
-- create draw order indices
|
|
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 <- newVertexBuffer vertexPositions
|
|
|
|
-- 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]
|
|
|
|
unbind va
|
|
unbind vbo
|
|
unbind ibo
|
|
unbind sp
|
|
|
|
-- store the mtrices for later adjustments
|
|
proj <- newMVar mproj
|
|
view <- newMVar mview
|
|
model <- newMVar mmodel
|
|
|
|
return $ Texture2DBatched model view proj vao va ibo sp
|
|
|
|
update _ _ = return ()
|
|
|
|
onEvents (Texture2DBatched model view proj vao va ibo sp) evs = do
|
|
-- modify the mvars based on keystrokes
|
|
moveObj proj view model evs
|
|
|
|
render (Texture2DBatched model view proj vao va ibo sp) = do
|
|
-- retrieve matrices from MVars
|
|
mproj <- readMVar proj
|
|
mview <- readMVar view
|
|
|
|
GL.clearColor $= GL.Color4 0 0 0 1
|
|
clear
|
|
mmodel <- readMVar model
|
|
bind sp
|
|
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
|
|
|
|
-- the actual drawing happens here
|
|
draw va ibo sp
|
|
|
|
moveObj
|
|
:: MVar (M44 GL.GLfloat)
|
|
-> MVar (M44 GL.GLfloat)
|
|
-> MVar (M44 GL.GLfloat)
|
|
-> [SDL.Event]
|
|
-> IO ()
|
|
moveObj proj view model evs =
|
|
modifyMVar_ proj (\mproj -> do
|
|
modifyMVar_ view (\mview -> do
|
|
modifyMVar_ model (\mmodel -> do
|
|
let plusModel = foldl (\acc ev -> case SDL.eventPayload ev of
|
|
(SDL.KeyboardEvent
|
|
( SDL.KeyboardEventData
|
|
_
|
|
SDL.Pressed
|
|
_
|
|
(SDL.Keysym _ code mod)
|
|
))
|
|
->
|
|
let trans =
|
|
mkTransformationMat
|
|
(identity :: M33 GL.GLfloat)
|
|
( ( if SDL.keyModifierLeftShift mod
|
|
then (-1)
|
|
else 1
|
|
)
|
|
*
|
|
( case code of
|
|
SDL.KeycodeX ->
|
|
V3 1 0 0
|
|
SDL.KeycodeY ->
|
|
V3 0 1 0
|
|
_ ->
|
|
V3 0 0 0
|
|
)
|
|
)
|
|
!-!
|
|
(identity :: M44 GL.GLfloat)
|
|
in acc !+! trans
|
|
_ -> acc
|
|
)
|
|
zero
|
|
evs
|
|
let retval = mmodel !+! plusModel
|
|
when (not $ plusModel == zero) $
|
|
print ("Current Position of object: " <>
|
|
show (Lens.view translation $ retval))
|
|
return retval
|
|
)
|
|
return mview
|
|
)
|
|
return mproj
|
|
)
|