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)
|
|
|
|
|