diff --git a/pituicat.cabal b/pituicat.cabal index 88074e6..81c5033 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -25,7 +25,9 @@ executable pituicat , Types.Graphics , Types.Graphics.VertexArray , Types.Graphics.VertexBuffer + , Types.Util , Classes + , Classes.Scene , Classes.Graphics , Classes.Graphics.Bindable , Classes.Graphics.Buffer @@ -37,6 +39,7 @@ executable pituicat , State.MainGame.Load , State.MainGame.Update , State.MainGame.Draw + , Scenes.Test , Map , StateMachine , Texture diff --git a/src/Classes/Scene.hs b/src/Classes/Scene.hs index 70d9793..df9714c 100644 --- a/src/Classes/Scene.hs +++ b/src/Classes/Scene.hs @@ -16,7 +16,7 @@ class Scene a where initScene :: IO a -- | Load actual data into the initialized container. - loadScene :: a -> TMVar Progress -> IO a + loadScene :: a -> TMVar Progress -> IO () -- | Query whether loading data is finished. isSceneLoaded :: a -> Affection Bool diff --git a/src/Main.hs b/src/Main.hs index b17d76d..b118882 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -56,12 +56,6 @@ main = do preLoad :: GameData -> Affection () preLoad gd = liftIO $ do - 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 - va <- newVertexArray scene <- liftIO $ (initScene :: IO Test) atomically $ putTMVar (gameScene gd) (Stage scene) diff --git a/src/Scenes/Test.hs b/src/Scenes/Test.hs index b7717e0..003201a 100644 --- a/src/Scenes/Test.hs +++ b/src/Scenes/Test.hs @@ -3,10 +3,17 @@ module Scenes.Test where import Affection +import SDL (($=), get) +import qualified SDL + +import qualified Graphics.Rendering.OpenGL as GL + import Control.Concurrent.STM import Control.Monad (void) +import Linear + -- internal imports import Types @@ -30,9 +37,22 @@ instance Scene Test where atomically $ putTMVar (testMap level) loadedMap void $ atomically $ do void $ takeTMVar progress - putTMVar progress (1, "Loaded test level!") + putTMVar progress (0.5, "Loaded test level map!") void $ atomically $ swapTVar (testLoaded level) True - return level + + 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!") + isSceneLoaded = liftIO . atomically . readTVar . testLoaded diff --git a/src/State/MainGame/Load.hs b/src/State/MainGame/Load.hs index 00979fb..569beff 100644 --- a/src/State/MainGame/Load.hs +++ b/src/State/MainGame/Load.hs @@ -31,7 +31,8 @@ loadFork -> IO () loadFork stage progress = do (Stage sceneContainer) <- atomically $ readTMVar stage - void . atomically . swapTMVar stage =<< Stage <$> loadScene sceneContainer progress + loadScene sceneContainer progress + void $ atomically $ swapTMVar stage (Stage sceneContainer) -- atomically $ do -- _ <- takeTMVar progress -- putTMVar progress (0, "Loading test level...")