bump module Load to affection 0.0.0.10

src/Load.hs

@@ -7,7 +7,7 @@ import Graphics.Rendering.OpenGL.GL.FlushFinish (finish)
 
 import Control.Concurrent (forkIO)
 import Control.Concurrent.MVar
-import Control.Monad (when)
+import Control.Monad
 
 import qualified Data.Map as M
 import qualified Data.Text as T
@@ -25,39 +25,39 @@ import Menu.Connect
 import Types
 import Util
 
-loadLoad :: Affection UserData ()
-loadLoad = do
+loadLoad :: UserData -> Affection ()
+loadLoad ud = do
   ad <- A.get
-  ud <- getAffection
-  progress <- liftIO $ newMVar (0, "Starting up")
-  future <- liftIO newEmptyMVar
+  wState <- liftIO $ readMVar (worldState ud)
+  curWin <- liftIO $ readMVar (window ud)
+  tContext <- liftIO $ readMVar (threadContext ud)
+  let progress = (0, "Starting up")
+  void $ liftIO $ swapMVar (stateProgress ud) progress
+  void $ liftIO $ tryReadMVar (stateMVar ud)
   _ <- liftIO $ createFont (nano ud) "bedstead"
     (FileName "assets/font/Bedstead-Semicondensed.ttf")
   _ <- liftIO $ forkIO $
     loadFork
-      (worldState ud)
-      (fromJust $ window ud)
-      (fromJust $ threadContext ud)
+      wState
+      (fromJust curWin)
+      (fromJust tContext)
       (nano ud)
-      future
-      progress
-  SDL.glMakeCurrent (fromJust $ window ud) (snd $ head $ glContext ad)
-  putAffection ud
-    { stateMVar = future
-    , stateProgress = progress
-    , state = Load
-    , assetFonts  = M.fromList
+      (stateMVar ud)
+      (stateProgress ud)
+  SDL.glMakeCurrent (fromJust curWin) (snd $ head $ glContext ad)
+  void $ liftIO $ swapMVar (state ud) Load
+  void $ liftIO $ swapMVar (assetFonts ud) (M.fromList
     [ (FontBedstead, "bedstead")
     ]
-    }
+    )
 
 loadFork
-  :: SystemState Entity (AffectionState (AffectionData UserData) IO)
+  :: SystemState Entity (AffectionState (AffectionData) IO)
   -> SDL.Window
   -> SDL.GLContext
   -> Context
   -> MVar
-    ( SystemState Entity (AffectionState (AffectionData UserData) IO)
+    ( SystemState Entity (AffectionState (AffectionData) IO)
     , StateData
     )
   -> MVar (Float, T.Text)
@@ -525,30 +525,24 @@ loadFork ws win glc nvg future progress = do
       }
     )
 
-drawLoad :: Affection UserData ()
-drawLoad = do
-  ud <- getAffection
+drawLoad :: UserData -> Affection ()
+drawLoad ud = do
   progress <- liftIO $ readMVar (stateProgress ud)
   liftIO $ do
     logIO A.Verbose ("LoadProgress: " <> fromString (show progress))
     drawLoadScreen ud progress
 
-updateLoad :: Double -> Affection UserData ()
-updateLoad _ = do
-  ud <- getAffection
+updateLoad :: UserData -> Double -> Affection ()
+updateLoad ud _ = do
   mwsld <- liftIO $ tryTakeMVar (stateMVar ud)
   case mwsld of
     Just (_, ld) -> do
       liftIO $ logIO A.Debug "loaded assets, entering menu"
-      putAffection ud
-        { assetImages     = loadAssetImages ld
-        , assetAnimations = loadAssetAnims ld
-        , assetIcons      = loadAssetIcons ld
-        -- , state           = Main WorldMap
-        -- , state           = Menu Connect
-        , stateData       = None
-        }
+      void $ liftIO $ swapMVar (assetImages ud) (loadAssetImages ld)
+      void $ liftIO $ swapMVar (assetAnimations ud) (loadAssetAnims ld)
+      void $ liftIO $ swapMVar (assetIcons ud) (loadAssetIcons ld)
+      void $ liftIO $ swapMVar (stateData ud) None
       -- loadMap
-      loadMenu
+      loadMenu ud
     Nothing ->
       return ()