module Scenes.Texture2D where import SDL (($=), get) import qualified SDL import qualified SDL.Internal.Numbered as SDL import qualified Graphics.Rendering.OpenGL as GL 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 Texture2D = Texture2D { texModels :: [MVar (M44 GL.GLfloat)] , texView :: MVar (M44 GL.GLfloat) , texProj :: MVar (M44 GL.GLfloat) , texFocus :: MVar Int , texVertArrObj :: GL.VertexArrayObject , texVertArray :: VertexArray , texIdxBUfObj :: IndexBuffer GL.GLuint , texShaderProg :: Shader } instance SceneClass Texture2D 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) mmodel1 = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0) mmodel2 = 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 | texture coordinates [ -67, -100, 0, 0, 0 , 67, -100, 0, 1, 0 , 67, 100, 0, 1, 1 , -67, 100, 0, 0, 1 ] :: [GL.GLfloat] -- create draw order indices indices = [0, 1, 2, 2, 3, 0] :: [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 $ 5 * sizeOf (undefined :: GL.GLfloat)) -- push vertex positions pushElements layout 0 GL.Float 3 (0 * (sizeOf (undefined :: GL.GLfloat))) -- pusht texture coordinates pushElements layout 1 GL.Float 2 (3 * (sizeOf (undefined :: GL.GLfloat))) addBuffer va vbo layout -- -- TEXTURE -- generate and bind texture tex <- newTexture "res/textures/lynx.jpg" 0 bind tex -- -- tell the shader where to find the texture sp <- newShader [ ShaderSource GL.VertexShader "./res/shaders/vert.shader" , ShaderSource GL.FragmentShader "./res/shaders/frag.shader" ] bind sp setUniform sp "u_texture" (texSlot tex) -- unbind everything again unbind va unbind vbo unbind ibo unbind sp -- store the mtrices for later adjustments proj <- newMVar mproj view <- newMVar mview model1 <- newMVar mmodel1 model2 <- newMVar mmodel2 focus <- newMVar 0 return $ Texture2D [model1, model2] view proj focus vao va ibo sp update _ _ = return () onEvents (Texture2D models view proj focus vao va ibo sp) evs = do -- modify the mvars based on keystrokes switchObject focus models evs foc <- readMVar focus moveObj proj view (models !! foc) evs render (Texture2D [model1, model2] 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 mmodel1 <- readMVar model1 bind sp setUniform sp "u_mvp" (mproj !*! mview !*! mmodel1) -- the actual drawing happens here draw va ibo sp -- -- bind shader and provide mvp for object2 and draw it mmodel2 <- readMVar model2 bind sp setUniform sp "u_mvp" (mproj !*! mview !*! mmodel2) -- 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 ) switchObject :: MVar Int -> [MVar (M44 GL.GLfloat)] -> [SDL.Event] -> IO () switchObject focus elems evs = modifyMVar_ focus (\foc -> do foldM (\acc ev -> case SDL.eventPayload ev of (SDL.KeyboardEvent (SDL.KeyboardEventData _ SDL.Pressed _ (SDL.Keysym code _ mod) )) -> do let selectIndex = fromIntegral (SDL.toNumber code) - 30 if ((selectIndex < 10) && (selectIndex >= 0)) && (SDL.toNumber mod == 0) && (selectIndex < length elems) && (acc /= selectIndex) then do print ("selected element number: " <> show selectIndex) return $ selectIndex else return foc _ -> return acc ) foc evs )