diff --git a/src/Main.hs b/src/Main.hs index 6ab6d7b..df655f1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -56,7 +56,7 @@ preLoad gd = vertexArrayObject <- GL.genObjectName va <- newVertexArray - atomically $ writeTVar (gameState gd) Loading + atomically $ (writeTVar (gameScene gd) =<< (initScene :: IO Test)) handle :: GameData -> [SDL.EventPayload] -> Affection () @@ -66,14 +66,17 @@ handle gd evs = do update :: GameData -> Double -> Affection () update gd dt = do - state <- liftIO (atomically $ readTVar $ gameState gd) - progressMeter <- liftIO $ atomically (fst <$> readTMVar (gameStateLoadProgress gd)) - if progressMeter < 0 - then do - -- liftIO (atomically (putTMVar (gameStateLoadProgress gd) (0, "Ohai!"))) - smLoad state gd + state <- liftIO $ atomically $ readTVar $ gameState gd + isStagePresent <- atomically $ isEmptyTMVar $ gamescene gd + if isStagePresent + then + stage <- liftIO $ atomically $ readTVar $ gameScene gd + then + smLoad state gd + else + smUpdate state gd dt else - smUpdate state gd dt + return () draw :: GameData -> Affection () draw gd = do @@ -82,9 +85,9 @@ draw gd = do init :: IO GameData init = GameData - <$> newTVarIO Loading - <*> newTMVarIO (-1, "Ohai!") - <*> newTMVarIO EmptyData + <$> newEmptyTMVarIO + <*> newTVarIO Loading + <*> newTMVarIO (0, "Ohai!") <*> (Subsystems <$> (SubWindow <$> newTVarIO []) <*> (SubMouse <$> newTVarIO []) diff --git a/src/State/Loading/Load.hs b/src/State/Loading/Load.hs index f2aa6aa..dc6972f 100644 --- a/src/State/Loading/Load.hs +++ b/src/State/Loading/Load.hs @@ -27,4 +27,4 @@ initLoad :: GameData -> Affection () initLoad gd = - liftIO $ atomically $ writeTVar (gameState gd) (MainGame Test) + liftIO $ atomically $ writeTVar (gameState gd) Running diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 079a9d4..e337f8e 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -16,15 +16,12 @@ import State.MainGame instance StateMachine GameData State where smLoad Loading = initLoad - smLoad (MainGame Test) = mainGameLoad smLoad x = error ("State load not yet implemented: " <> show x) smUpdate Loading = initLoadUpdate - smUpdate (MainGame Test) = mainGameUpdate smUpdate x = error ("State update not yet implemented: " <> show x) smDraw Loading = initLoadDraw - smDraw (MainGame Test) = mainGameDraw smDraw x = error ("State draw not yet implemented: " <> show x) smEvent _ gd evs = do diff --git a/src/Types/Application.hs b/src/Types/Application.hs index ca5c307..98093f8 100644 --- a/src/Types/Application.hs +++ b/src/Types/Application.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ExistentialQuantification #-} module Types.Application where import Affection @@ -16,61 +17,24 @@ import Types.Subsystems import Types.GameMap data GameData = GameData - { gameState :: TVar State + { gameScene :: TMVar Stage + , gameState :: TVar State , gameStateLoadProgress :: TMVar Progress - , gameStateData :: TMVar StateData , gameSubsystems :: Subsystems , gameActionTranslation :: TVar ActionTranslation , gameRunning :: TVar Bool } +-- Existential type wrapper to make all Scenes implementing Scene +-- homogenous. +-- See more at https://wiki.haskell.org/Existential_type#Dynamic_dispatch_mechanism_of_OOP +data Stage = forall a. Scene a => Stage a + data State = Loading - | Menu MenuState - | MainGame Level - deriving (Eq, Show) - -data MenuState - = MenuMain - | MenuSettings - deriving (Eq , Show) - -data Level - = DNAMenu - | Sewer01 - | Sewer02 - | Sewer03 - | Sewer04 - | Alley01 - | Alley02 - | Alley03 - | Alley04 - | Lab01 - | Lab02 - | Lab03 - | Lab04 - | Highway01 - | Highway02 - | Highway03 - | Highway04 - | Complex01 - | Complex02 - | Complex03 - | Complex04 - | Base01 - | Base02 - | Base03 - | Base04 - | Test - deriving (Enum, Eq, Show) + | Running + | Pausing type Progress = (Float, T.Text) type ActionTranslation = M.Map SDL.Keycode Action - -data StateData - = EmptyData - | TestData - { testMap :: LevelMap - } - deriving (Eq, Show)