pituicat/src/Scenes/Test.hs

72 lines
1.5 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
2020-12-05 09:10:37 +00:00
import Classes
2020-10-28 10:48:58 +00:00
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)
vertexArray <- newVertexArray
2020-12-05 09:10:37 +00:00
bind vertexArray
2020-10-30 06:38:18 +00:00
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)