better loading

src/MainGame/WorldMap.hs

@@ -81,14 +81,21 @@ loadMapFork
   -> MVar (Float, T.Text)
   -> IO ()
 loadMapFork ud ad future progress = do
-  let loadSteps = 20
+  let loadSteps = 22
+      increment = 1 / loadSteps
       fc = FloorConfig
         (10, 10)
         [] -- [(5, 5), (5, 20)]
         (40, 40)
-  _ <- liftIO $ swapMVar progress (1 / loadSteps, "Building floor")
+  modifyMVar_ progress (return . (\(p, _) ->
-  (mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps)
+    ( p + increment
-  _ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images")
+    , "Building floor"
+    )))
+  (mat, gr) <- buildHallFloorIO fc progress increment -- 10 increments inside
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Converting to images"
+    )))
   let imgmat = convertTileToImg mat
       exits = Prelude.foldl
         (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty
@@ -97,19 +104,34 @@ loadMapFork ud ad future progress = do
           )
         []
         ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat])
-  _ <- liftIO $ swapMVar progress (12 / loadSteps, "Placing furniture")
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Placing furniture"
+    )))
   (inter, rps) <- placeInteriorIO mat imgmat exits gr
-  _ <- liftIO $ swapMVar progress (13 / loadSteps, "Placing NPCs")
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Placing NPCs"
+    )))
   logIO A.Debug ("number of reachpoints: " ++ show (length rps))
   let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
   npcposs <- placeNPCs inter mat rps 40 -- (length $ filter (\a -> pointType a == Table) nnex)
-  _ <- liftIO $ swapMVar progress (14 / loadSteps, "Preparing MindMap graph")
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Preparing MindMap graph"
+    )))
   A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
   (mmintmat, mmgraph) <- buildFloorMap . springField <$>
     buildMindMap (length npcposs) 2
-  _ <- liftIO $ swapMVar progress (15 / loadSteps, "Unfolding and Converting MindMap to images")
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Unfolding and Converting MindMap to images"
+    )))
   let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat
-  _ <- liftIO $ swapMVar progress (16 / loadSteps, "Creating WorldState")
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Creating WorldState and placing player"
+    )))
   (nws, _) <- evalStateT (runState (yieldSystemT (worldState ud) $ do
     let pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos
           (fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph))
@@ -132,7 +154,10 @@ loadMapFork ud ad future progress = do
       , rot           = Just SE
       , anim          = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0
       }
-    void $ liftIO $ swapMVar progress (17 / loadSteps, "Registering copiers into WorldState")
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Registering copiers into WorldState"
+      )))
     let copiers = Prelude.filter (\a -> pointType a == Copier) rps
     mapM_ (\(ReachPoint _ icoord _) -> do
       let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
@@ -145,7 +170,10 @@ loadMapFork ud ad future progress = do
         , objState  = Just "idle"
         }
       ) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers)
-    void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering computers into WorldState")
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Registering computers into WorldState"
+      )))
     let computers = Prelude.filter (\a -> pointType a == Computer) rps
     mapM_ (\(ReachPoint _ icoord dir) -> do
       let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
@@ -160,7 +188,10 @@ loadMapFork ud ad future progress = do
         , objState  = Just "off"
         }
       ) (A.log A.Debug ("number of computers: " ++ show (length computers)) computers)
-    void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering toilets into WorldState")
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Registering toilets into WorldState"
+      )))
     let toilets = Prelude.filter (\a -> pointType a == Toilet) rps
     mapM_ (\(ReachPoint _ icoord dir) -> do
       let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
@@ -172,7 +203,10 @@ loadMapFork ud ad future progress = do
         , objType   = Just ObjToilet
         }
       ) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets)
-    void $ liftIO $ swapMVar progress (19 / loadSteps, "Registering NPCs into WorldState")
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Registering NPCs into WorldState"
+      )))
     posbounds <- efor allEnts $ do
       with pos
       with obstacle
@@ -193,7 +227,10 @@ loadMapFork ud ad future progress = do
         , anim          = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
         }
       ) npcposs
-    void $ liftIO $ swapMVar progress (20 / loadSteps, "Handing over")
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Handing over"
+      )))
     )) ad
   putMVar future (nws, MainData
       { mapMat = mat