Draft more state implementation and make engine verbose

cabal.project

@@ -1,3 +1,3 @@
 packages:
   ./
-  ./extern/*/
+  -- ./extern/*

pituicat.cabal

@@ -28,6 +28,10 @@ executable pituicat
                      , State.Loading.Load
                      , State.Loading.Update
                      , State.Loading.Draw
+                     , State.MainGame
+                     , State.MainGame.Load
+                     , State.MainGame.Update
+                     , State.MainGame.Draw
                      , Map
                      , StateMachine
                      , Texture

shell.nix

@@ -13,6 +13,7 @@ let
       pname = "affection";
       version = "0.0.0.10";
       src = ./extern/affection;
+      configureFlags = [ "-fverbose" ];
       isLibrary = true;
       isExecutable = true;
       libraryHaskellDepends = [

src/Main.hs

@@ -19,7 +19,7 @@ import StateMachine
 import Types
 
 instance Affectionate GameData where
-  preLoop = smLoad Loading
+  preLoop = preLoad
   handleEvents = handle
   update = Main.update
   draw = Main.draw
@@ -47,6 +47,11 @@ main = do
         } :: AffectionConfig GameData
   withAffection config
 
+preLoad :: GameData -> Affection ()
+preLoad gd = do
+  liftIO $ atomically $ writeTVar (gameState gd) Loading
+  
+
 handle :: GameData -> [SDL.EventPayload] -> Affection ()
 handle gd evs = do
   state <- liftIO (atomically $ readTVar $ gameState gd)
@@ -55,7 +60,13 @@ handle gd evs = do
 update :: GameData -> Double -> Affection ()
 update gd dt = do
   state <- liftIO (atomically $ readTVar $ gameState gd)
-  smUpdate state gd dt
+  progressMeter <- liftIO $ atomically (fst <$> readTMVar (gameStateLoadProgress gd))
+  if progressMeter < 0
+  then do
+    -- liftIO (atomically (putTMVar (gameStateLoadProgress gd) (0, "Ohai!")))
+    smLoad state gd
+  else
+    smUpdate state gd dt
 
 draw :: GameData -> Affection ()
 draw gd = do
@@ -65,7 +76,8 @@ draw gd = do
 init :: IO GameData
 init = GameData
   <$> newTVarIO Loading
-  <*> newTVarIO EmptyData
+  <*> newTMVarIO (-1, "Ohai!")
+  <*> newTMVarIO EmptyData
   <*> (Subsystems
     <$> (SubWindow <$> newTVarIO [])
     <*> (SubMouse <$> newTVarIO [])

src/State/Loading/Load.hs

@@ -23,11 +23,8 @@ import Control.Concurrent.STM
 import Types
 import Map
 
-initLoadLoad
+initLoad
   :: GameData
   -> Affection ()
-initLoadLoad gd = do
-  stateData <- liftIO (TestData <$> constructMap testLevelDesc 0)
-  liftIO $ atomically $ do
-    writeTVar (gameStateData gd) stateData
-    writeTVar (gameState gd) (MainGame Test)
+initLoad gd =
+  liftIO $ atomically $ writeTVar (gameState gd) (MainGame Test)

src/State/MainGame.hs

@@ -0,0 +1,7 @@
+module State.MainGame
+  ( module L
+  ) where
+
+import State.MainGame.Load as L
+import State.MainGame.Update as L
+import State.MainGame.Draw as L

src/State/MainGame/Draw.hs

@@ -0,0 +1,10 @@
+module State.MainGame.Draw where
+
+import Affection
+
+-- internal imports
+
+import Types
+
+mainGameDraw :: GameData -> Affection ()
+mainGameDraw gd = return ()

src/State/MainGame/Load.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+module State.MainGame.Load where
+
+import Affection
+
+import Control.Concurrent (forkIO)
+import Control.Concurrent.STM
+
+import Control.Monad (void)
+
+-- internal imports
+
+import Types
+import Map
+
+mainGameLoad
+  :: GameData
+  -> Affection ()
+mainGameLoad gd = do
+  liftIO $ atomically $ do
+    _ <- takeTMVar (gameStateLoadProgress gd)
+    putTMVar (gameStateLoadProgress gd) (0, "Ohai!")
+  liftIO $ logIO Verbose "Entering main Game"
+  liftIO $ void $ forkIO $ loadFork (gameStateData gd) (gameStateLoadProgress gd)
+
+loadFork
+  :: TMVar StateData
+  -> TMVar Progress
+  -> IO ()
+loadFork dataContainer progress = do
+  atomically $ do
+    _ <- takeTMVar progress
+    putTMVar progress (0, "Loading test level...")
+  testData <- TestData <$> constructMap testLevelDesc 0
+  atomically $ do
+    _ <- takeTMVar dataContainer
+    putTMVar dataContainer testData
+    _ <- takeTMVar progress
+    putTMVar progress (1, "Loaded test level!")

src/State/MainGame/Update.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE OverloadedStrings #-}
+module State.MainGame.Update where
+
+import Affection
+
+import Control.Monad (when)
+
+import Control.Concurrent.STM
+
+-- internal imports
+
+import Types
+
+mainGameUpdate :: GameData -> Double -> Affection ()
+mainGameUpdate gd dt = do
+  progress <- liftIO $ atomically $ readTMVar (gameStateLoadProgress gd)
+  when (fst progress < 1) $ liftIO $ logIO Verbose (snd progress)

src/StateMachine.hs

@@ -11,16 +11,20 @@ import Control.Monad (void)
 import Types
 
 import State.Loading
+import State.MainGame
 
 instance StateMachine GameData State where
 
-  smLoad Loading = initLoadLoad
+  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

@@ -8,6 +8,8 @@ import Control.Concurrent.STM
 
 import qualified Data.Map.Strict as M
 
+import qualified Data.Text as T
+
 -- internal imports
 
 import Types.Subsystems
@@ -15,7 +17,8 @@ import Types.GameMap
 
 data GameData = GameData
   { gameState             :: TVar State
-  , gameStateData         :: TVar StateData
+  , gameStateLoadProgress :: TMVar Progress
+  , gameStateData         :: TMVar StateData
   , gameSubsystems        :: Subsystems
   , gameActionTranslation :: TVar ActionTranslation
   , gameRunning           :: TVar Bool
@@ -61,6 +64,8 @@ data Level
   | Test
   deriving (Enum, Eq, Show)
 
+type Progress = (Float, T.Text)
+
 type ActionTranslation = M.Map SDL.Keycode Action
 
 data StateData
@@ -68,3 +73,4 @@ data StateData
   | TestData
     { testMap :: LevelMap
     }
+  deriving (Eq, Show)