2020-10-17 08:35:25 +00:00
|
|
|
{-# 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
|
2020-10-28 10:48:58 +00:00
|
|
|
import Classes.Scene
|
2020-10-17 08:35:25 +00:00
|
|
|
|
|
|
|
mainGameLoad
|
|
|
|
:: GameData
|
|
|
|
-> Affection ()
|
|
|
|
mainGameLoad gd = do
|
|
|
|
liftIO $ atomically $ do
|
|
|
|
_ <- takeTMVar (gameStateLoadProgress gd)
|
|
|
|
putTMVar (gameStateLoadProgress gd) (0, "Ohai!")
|
|
|
|
liftIO $ logIO Verbose "Entering main Game"
|
2020-10-28 10:48:58 +00:00
|
|
|
tid <- liftIO $ forkIO $ loadFork (gameScene gd) (gameStateLoadProgress gd)
|
|
|
|
liftIO $ atomically $ writeTVar (gameLoadThread gd) (Just tid)
|
2020-10-17 08:35:25 +00:00
|
|
|
|
|
|
|
loadFork
|
2020-10-28 10:48:58 +00:00
|
|
|
:: TMVar Stage
|
2020-10-17 08:35:25 +00:00
|
|
|
-> TMVar Progress
|
|
|
|
-> IO ()
|
2020-10-28 10:48:58 +00:00
|
|
|
loadFork stage progress = do
|
|
|
|
(Stage sceneContainer) <- atomically $ readTMVar stage
|
2020-10-30 06:38:18 +00:00
|
|
|
loadScene sceneContainer progress
|
|
|
|
void $ atomically $ swapTMVar stage (Stage sceneContainer)
|
2020-10-28 10:48:58 +00:00
|
|
|
-- 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!")
|