pituicat/src/State/MainGame/Load.hs

45 lines
1.2 KiB
Haskell

{-# 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
import Classes.Scene
mainGameLoad
:: GameData
-> Affection ()
mainGameLoad gd = do
liftIO $ atomically $ do
_ <- takeTMVar (gameStateLoadProgress gd)
putTMVar (gameStateLoadProgress gd) (0, "Ohai!")
liftIO $ logIO Verbose "Entering main Game"
tid <- liftIO $ forkIO $ loadFork (gameScene gd) (gameStateLoadProgress gd)
liftIO $ atomically $ writeTVar (gameLoadThread gd) (Just tid)
loadFork
:: TMVar Stage
-> TMVar Progress
-> IO ()
loadFork stage progress = do
(Stage sceneContainer) <- atomically $ readTMVar stage
void . atomically . swapTMVar stage =<< Stage <$> loadScene sceneContainer progress
-- atomically $ do
-- _ <- takeTMVar progress
-- putTMVar progress (0, "Loading test level...")
-- testData <- TestData <$> constructMap testLevelDesc 0
-- print testData
-- atomically $ do
-- _ <- takeTMVar dataContainer
-- putTMVar dataContainer testData
-- _ <- takeTMVar progress
-- putTMVar progress (1, "Loaded test level!")