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

View File

@ -27,4 +27,4 @@ initLoad
:: GameData
-> Affection ()
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
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

View File

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