diff --git a/src/State/Loading.hs b/src/State/Loading.hs deleted file mode 100644 index c8a4231..0000000 --- a/src/State/Loading.hs +++ /dev/null @@ -1,7 +0,0 @@ -module State.Loading - ( module L - ) where - -import State.Loading.Load as L -import State.Loading.Update as L -import State.Loading.Draw as L diff --git a/src/State/Loading/Draw.hs b/src/State/Loading/Draw.hs deleted file mode 100644 index 2ae2249..0000000 --- a/src/State/Loading/Draw.hs +++ /dev/null @@ -1,10 +0,0 @@ -module State.Loading.Draw where - -import Affection - --- internal imports - -import Types - -initLoadDraw :: GameData -> Affection () -initLoadDraw gd = return () diff --git a/src/State/Loading/Load.hs b/src/State/Loading/Load.hs deleted file mode 100644 index 3652d0e..0000000 --- a/src/State/Loading/Load.hs +++ /dev/null @@ -1,35 +0,0 @@ -module State.Loading.Load where - -import Affection - -import SDL (($=), get) -import qualified SDL -import qualified SDL.Internal.Numbered as SDL -import qualified SDL.Raw.Video as SDL (glSetAttribute) -import qualified SDL.Raw.Enum as SDL - -import qualified Graphics.Rendering.OpenGL as GL -import qualified Graphics.GL as GLRaw - -import Foreign.Marshal.Array - -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 - -import Control.Concurrent (forkIO) - -import Control.Concurrent.STM - --- internal imports - -import Types -import Classes -import Map - -initLoad - :: GameData - -> Affection () -initLoad gd = do - (Stage scene) <- liftIO $ atomically $ readTMVar $ gameScene gd - tid <- liftIO $ forkIO $ loadScene scene (gameStateLoadProgress gd) - liftIO $ atomically $ writeTVar (gameLoadThread gd) (Just tid) diff --git a/src/State/Loading/Update.hs b/src/State/Loading/Update.hs deleted file mode 100644 index ac984ef..0000000 --- a/src/State/Loading/Update.hs +++ /dev/null @@ -1,10 +0,0 @@ -module State.Loading.Update where - -import Affection - --- internal imports - -import Types - -initLoadUpdate :: GameData -> Double -> Affection () -initLoadUpdate gd dt = return () diff --git a/src/State/MainGame.hs b/src/State/MainGame.hs deleted file mode 100644 index 6339f70..0000000 --- a/src/State/MainGame.hs +++ /dev/null @@ -1,7 +0,0 @@ -module State.MainGame - ( module L - ) where - -import State.MainGame.Load as L -import State.MainGame.Update as L -import State.MainGame.Draw as L diff --git a/src/State/MainGame/Draw.hs b/src/State/MainGame/Draw.hs deleted file mode 100644 index 27dffe4..0000000 --- a/src/State/MainGame/Draw.hs +++ /dev/null @@ -1,10 +0,0 @@ -module State.MainGame.Draw where - -import Affection - --- internal imports - -import Types - -mainGameDraw :: GameData -> Affection () -mainGameDraw gd = return () diff --git a/src/State/MainGame/Load.hs b/src/State/MainGame/Load.hs deleted file mode 100644 index 569beff..0000000 --- a/src/State/MainGame/Load.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# 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 - loadScene sceneContainer progress - void $ atomically $ swapTMVar stage (Stage sceneContainer) - -- 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!") diff --git a/src/State/MainGame/Update.hs b/src/State/MainGame/Update.hs deleted file mode 100644 index 8b824ba..0000000 --- a/src/State/MainGame/Update.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# 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)