{-# LANGUAGE OverloadedStrings #-} module Scenes.Test where import Affection import SDL (($=), get) import qualified SDL import qualified Graphics.Rendering.OpenGL as GL import qualified Data.Vector.Storable as VS import Control.Concurrent.STM import Control.Monad (void) import Linear -- internal imports import Types import Classes import Map import Renderer as R data Test = Test { testMap :: TMVar LevelMap , testGraphics :: TMVar GLAssets , testLoaded :: TVar Bool } data GLAssets = GLAssets { glVA :: VertexArray , glVB :: VertexBuffer , glIB :: IndexBuffer , glSP :: Shader } instance Scene Test where initScene = Test <$> newEmptyTMVarIO <*> newEmptyTMVarIO <*> newTVarIO False loadScene level progress = do atomically $ do void $ takeTMVar progress putTMVar progress (0, "Loading test level...") loadedMap <- constructMap testLevelDesc 0 atomically $ putTMVar (testMap level) loadedMap void $ atomically $ do void $ takeTMVar progress putTMVar progress (0.5, "Loaded test level map!") void $ atomically $ swapTVar (testLoaded level) True let projection = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat view = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0) model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0) vertexArray <- newVertexArray bind vertexArray vertexBuffer <- newVertexBuffer 1024 bind vertexBuffer let vertices = VS.fromList (createQuad (V2 (400 - 16) (300 - 16)) 0) write vertexBuffer 0 vertices indexBuffer <- newIndexBuffer 1024 bind indexBuffer let indices = VS.fromList [0, 1, 2, 2, 3, 0] write indexBuffer 0 indices addBuffer (undefined :: Vertex) vertexBuffer shader <- newShader [ ShaderSource GL.VertexShader "./res/shaders/vert.shader" , ShaderSource GL.FragmentShader "./res/shaders/frag.shader" ] bind shader setUniform shader "u_mvp" (projection !*! view !*! model) unbind vertexArray unbind vertexBuffer unbind indexBuffer unbind shader atomically $ do putTMVar (testGraphics level) (GLAssets vertexArray vertexBuffer indexBuffer shader) writeTVar (testLoaded level) True void $ atomically $ do void $ takeTMVar progress putTMVar progress (1, "Loaded graphics!") isSceneLoaded = liftIO . atomically . readTVar . testLoaded update _ _ = return () onEvents _ _ = return () render level = liftIO $ do (GLAssets va vb ib sh) <- atomically (readTMVar $ testGraphics level) bind vb R.draw va ib sh testLevelDesc :: LevelDescriptor testLevelDesc = LevelDescriptor [ (0, "res/maps/00_test/00_test.bmp") ] 0 "res/tiles/00_test/00_test.png" (3, 3) createQuad :: V2 GL.GLfloat -> Int -> [Vertex] createQuad pos@(V2 x y) index = [ newVertex (V3 x y 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index) , newVertex (V3 (x + 32) y 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index) , newVertex (V3 (x + 32) (y + 32) 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index) , newVertex (V3 x (y + 32) 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index) ]