introduce scenes and thus get rid of overly big enums

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

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

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

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)