introduce scenes and thus get rid of overly big enums

This commit is contained in:
nek0 2020-10-25 19:33:18 +01:00
parent 31f56d62a3
commit 3b5d0a90ad
4 changed files with 25 additions and 61 deletions

View File

@ -56,7 +56,7 @@ preLoad gd =
vertexArrayObject <- GL.genObjectName vertexArrayObject <- GL.genObjectName
va <- newVertexArray va <- newVertexArray
atomically $ writeTVar (gameState gd) Loading atomically $ (writeTVar (gameScene gd) =<< (initScene :: IO Test))
handle :: GameData -> [SDL.EventPayload] -> Affection () handle :: GameData -> [SDL.EventPayload] -> Affection ()
@ -66,14 +66,17 @@ handle gd evs = do
update :: GameData -> Double -> Affection () update :: GameData -> Double -> Affection ()
update gd dt = do update gd dt = do
state <- liftIO (atomically $ readTVar $ gameState gd) state <- liftIO $ atomically $ readTVar $ gameState gd
progressMeter <- liftIO $ atomically (fst <$> readTMVar (gameStateLoadProgress gd)) isStagePresent <- atomically $ isEmptyTMVar $ gamescene gd
if progressMeter < 0 if isStagePresent
then do then
-- liftIO (atomically (putTMVar (gameStateLoadProgress gd) (0, "Ohai!"))) stage <- liftIO $ atomically $ readTVar $ gameScene gd
smLoad state gd then
smLoad state gd
else
smUpdate state gd dt
else else
smUpdate state gd dt return ()
draw :: GameData -> Affection () draw :: GameData -> Affection ()
draw gd = do draw gd = do
@ -82,9 +85,9 @@ draw gd = do
init :: IO GameData init :: IO GameData
init = GameData init = GameData
<$> newTVarIO Loading <$> newEmptyTMVarIO
<*> newTMVarIO (-1, "Ohai!") <*> newTVarIO Loading
<*> newTMVarIO EmptyData <*> newTMVarIO (0, "Ohai!")
<*> (Subsystems <*> (Subsystems
<$> (SubWindow <$> newTVarIO []) <$> (SubWindow <$> newTVarIO [])
<*> (SubMouse <$> newTVarIO []) <*> (SubMouse <$> newTVarIO [])

View File

@ -27,4 +27,4 @@ initLoad
:: GameData :: GameData
-> Affection () -> Affection ()
initLoad gd = initLoad gd =
liftIO $ atomically $ writeTVar (gameState gd) (MainGame Test) liftIO $ atomically $ writeTVar (gameState gd) Running

View File

@ -16,15 +16,12 @@ import State.MainGame
instance StateMachine GameData State where instance StateMachine GameData State where
smLoad Loading = initLoad smLoad Loading = initLoad
smLoad (MainGame Test) = mainGameLoad
smLoad x = error ("State load not yet implemented: " <> show x) smLoad x = error ("State load not yet implemented: " <> show x)
smUpdate Loading = initLoadUpdate smUpdate Loading = initLoadUpdate
smUpdate (MainGame Test) = mainGameUpdate
smUpdate x = error ("State update not yet implemented: " <> show x) smUpdate x = error ("State update not yet implemented: " <> show x)
smDraw Loading = initLoadDraw smDraw Loading = initLoadDraw
smDraw (MainGame Test) = mainGameDraw
smDraw x = error ("State draw not yet implemented: " <> show x) smDraw x = error ("State draw not yet implemented: " <> show x)
smEvent _ gd evs = do smEvent _ gd evs = do

View File

@ -1,3 +1,4 @@
{-# LANGUAGE ExistentialQuantification #-}
module Types.Application where module Types.Application where
import Affection import Affection
@ -16,61 +17,24 @@ import Types.Subsystems
import Types.GameMap import Types.GameMap
data GameData = GameData data GameData = GameData
{ gameState :: TVar State { gameScene :: TMVar Stage
, gameState :: TVar State
, gameStateLoadProgress :: TMVar Progress , gameStateLoadProgress :: TMVar Progress
, gameStateData :: TMVar StateData
, gameSubsystems :: Subsystems , gameSubsystems :: Subsystems
, gameActionTranslation :: TVar ActionTranslation , gameActionTranslation :: TVar ActionTranslation
, gameRunning :: TVar Bool , 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 data State
= Loading = Loading
| Menu MenuState | Running
| MainGame Level | Pausing
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)
type Progress = (Float, T.Text) type Progress = (Float, T.Text)
type ActionTranslation = M.Map SDL.Keycode Action type ActionTranslation = M.Map SDL.Keycode Action
data StateData
= EmptyData
| TestData
{ testMap :: LevelMap
}
deriving (Eq, Show)