{-# LANGUAGE OverloadedStrings #-} module Scenes.Test where import Affection 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 , glTx :: Texture } 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 (_, tex) <- newTexture "res/pituicat/pituicat.png" 0 bind tex 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) setUniform shader "u_texture" (0 :: GL.GLint) unbind vertexArray unbind vertexBuffer unbind indexBuffer unbind tex unbind shader atomically $ do putTMVar (testGraphics level) (GLAssets vertexArray vertexBuffer indexBuffer shader tex) 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 tx) <- atomically (readTMVar $ testGraphics level) bind va bind tx 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 (V2 x y) index = [ newVertex (V3 x y 0) (V4 0 0 0 1) (V2 0 (1 - (50 / 1024))) (fromIntegral index) , newVertex (V3 (x + 32) y 0) (V4 0 0 0 1) (V2 (50 / 1024) (1 - (50/1024))) (fromIntegral index) , newVertex (V3 (x + 32) (y + 32) 0) (V4 0 0 0 1) (V2 (50 / 1024) 1) (fromIntegral index) , newVertex (V3 x (y + 32) 0) (V4 0 0 0 1) (V2 0 1) (fromIntegral index) ]