pituicat/src/Scenes/Test.hs

73 lines
1.6 KiB
Haskell
Raw Normal View History

2020-10-28 10:48:58 +00:00
{-# LANGUAGE OverloadedStrings #-}
module Scenes.Test where
import Affection
2020-10-30 06:38:18 +00:00
import SDL (($=), get)
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL
2020-10-28 10:48:58 +00:00
import Control.Concurrent.STM
import Control.Monad (void)
2020-10-30 06:38:18 +00:00
import Linear
2020-10-28 10:48:58 +00:00
-- internal imports
import Types
import Map
import Classes.Scene
data Test = Test
{ testMap :: TMVar LevelMap
, testLoaded :: TVar Bool
}
instance Scene Test where
initScene = Test <$> 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
2020-10-30 06:38:18 +00:00
putTMVar progress (0.5, "Loaded test level map!")
2020-10-28 10:48:58 +00:00
void $ atomically $ swapTVar (testLoaded level) True
2020-10-30 06:38:18 +00:00
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)
vertexArrayObject <- GL.genObjectName
vertexArray <- newVertexArray
GL.bindVertexArrayObject $= Just vertexArrayObject
void $ atomically $ do
void $ takeTMVar progress
putTMVar progress (1, "Loaded graphics!")
2020-10-28 10:48:58 +00:00
isSceneLoaded = liftIO . atomically . readTVar . testLoaded
update _ _ = return ()
onEvents _ _ = return ()
render _ = return ()
testLevelDesc :: LevelDescriptor
testLevelDesc = LevelDescriptor
[ (0, "res/maps/00_test/00_test.bmp")
]
0
"res/tiles/00_test/00_test.png"
(3, 3)