start restructuring
This commit is contained in:
parent
dc78b0fe7b
commit
171f71180f
|
@ -25,7 +25,9 @@ executable pituicat
|
||||||
, Types.Graphics
|
, Types.Graphics
|
||||||
, Types.Graphics.VertexArray
|
, Types.Graphics.VertexArray
|
||||||
, Types.Graphics.VertexBuffer
|
, Types.Graphics.VertexBuffer
|
||||||
|
, Types.Util
|
||||||
, Classes
|
, Classes
|
||||||
|
, Classes.Scene
|
||||||
, Classes.Graphics
|
, Classes.Graphics
|
||||||
, Classes.Graphics.Bindable
|
, Classes.Graphics.Bindable
|
||||||
, Classes.Graphics.Buffer
|
, Classes.Graphics.Buffer
|
||||||
|
@ -37,6 +39,7 @@ executable pituicat
|
||||||
, State.MainGame.Load
|
, State.MainGame.Load
|
||||||
, State.MainGame.Update
|
, State.MainGame.Update
|
||||||
, State.MainGame.Draw
|
, State.MainGame.Draw
|
||||||
|
, Scenes.Test
|
||||||
, Map
|
, Map
|
||||||
, StateMachine
|
, StateMachine
|
||||||
, Texture
|
, Texture
|
||||||
|
|
|
@ -16,7 +16,7 @@ class Scene a where
|
||||||
initScene :: IO a
|
initScene :: IO a
|
||||||
|
|
||||||
-- | Load actual data into the initialized container.
|
-- | Load actual data into the initialized container.
|
||||||
loadScene :: a -> TMVar Progress -> IO a
|
loadScene :: a -> TMVar Progress -> IO ()
|
||||||
|
|
||||||
-- | Query whether loading data is finished.
|
-- | Query whether loading data is finished.
|
||||||
isSceneLoaded :: a -> Affection Bool
|
isSceneLoaded :: a -> Affection Bool
|
||||||
|
|
|
@ -56,12 +56,6 @@ main = do
|
||||||
preLoad :: GameData -> Affection ()
|
preLoad :: GameData -> Affection ()
|
||||||
preLoad gd =
|
preLoad gd =
|
||||||
liftIO $ do
|
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)
|
scene <- liftIO $ (initScene :: IO Test)
|
||||||
atomically $ putTMVar (gameScene gd) (Stage scene)
|
atomically $ putTMVar (gameScene gd) (Stage scene)
|
||||||
|
|
||||||
|
|
|
@ -3,10 +3,17 @@ module Scenes.Test where
|
||||||
|
|
||||||
import Affection
|
import Affection
|
||||||
|
|
||||||
|
import SDL (($=), get)
|
||||||
|
import qualified SDL
|
||||||
|
|
||||||
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
|
|
||||||
|
import Linear
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
@ -30,9 +37,22 @@ instance Scene Test where
|
||||||
atomically $ putTMVar (testMap level) loadedMap
|
atomically $ putTMVar (testMap level) loadedMap
|
||||||
void $ atomically $ do
|
void $ atomically $ do
|
||||||
void $ takeTMVar progress
|
void $ takeTMVar progress
|
||||||
putTMVar progress (1, "Loaded test level!")
|
putTMVar progress (0.5, "Loaded test level map!")
|
||||||
void $ atomically $ swapTVar (testLoaded level) True
|
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
|
isSceneLoaded = liftIO . atomically . readTVar . testLoaded
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,8 @@ loadFork
|
||||||
-> IO ()
|
-> IO ()
|
||||||
loadFork stage progress = do
|
loadFork stage progress = do
|
||||||
(Stage sceneContainer) <- atomically $ readTMVar stage
|
(Stage sceneContainer) <- atomically $ readTMVar stage
|
||||||
void . atomically . swapTMVar stage =<< Stage <$> loadScene sceneContainer progress
|
loadScene sceneContainer progress
|
||||||
|
void $ atomically $ swapTMVar stage (Stage sceneContainer)
|
||||||
-- atomically $ do
|
-- atomically $ do
|
||||||
-- _ <- takeTMVar progress
|
-- _ <- takeTMVar progress
|
||||||
-- putTMVar progress (0, "Loading test level...")
|
-- putTMVar progress (0, "Loading test level...")
|
||||||
|
|
Loading…
Reference in New Issue