better loading

This commit is contained in:
nek0 2018-09-07 19:12:04 +02:00
parent 5916f302a6
commit 9774f5a9c9

View file

@ -81,14 +81,21 @@ loadMapFork
-> MVar (Float, T.Text) -> MVar (Float, T.Text)
-> IO () -> IO ()
loadMapFork ud ad future progress = do loadMapFork ud ad future progress = do
let loadSteps = 20 let loadSteps = 22
increment = 1 / loadSteps
fc = FloorConfig fc = FloorConfig
(10, 10) (10, 10)
[] -- [(5, 5), (5, 20)] [] -- [(5, 5), (5, 20)]
(40, 40) (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 let imgmat = convertTileToImg mat
exits = Prelude.foldl exits = Prelude.foldl
(\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty (\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]) ((,) <$> [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 (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)) logIO A.Debug ("number of reachpoints: " ++ show (length rps))
let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
npcposs <- placeNPCs inter mat rps 40 -- (length $ filter (\a -> pointType a == Table) nnex) 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) A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
(mmintmat, mmgraph) <- buildFloorMap . springField <$> (mmintmat, mmgraph) <- buildFloorMap . springField <$>
buildMindMap (length npcposs) 2 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 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 (nws, _) <- evalStateT (runState (yieldSystemT (worldState ud) $ do
let pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos let pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos
(fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph)) (fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph))
@ -132,7 +154,10 @@ loadMapFork ud ad future progress = do
, rot = Just SE , rot = Just SE
, anim = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0 , 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 let copiers = Prelude.filter (\a -> pointType a == Copier) rps
mapM_ (\(ReachPoint _ icoord _) -> do mapM_ (\(ReachPoint _ icoord _) -> do
let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
@ -145,7 +170,10 @@ loadMapFork ud ad future progress = do
, objState = Just "idle" , objState = Just "idle"
} }
) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers) ) (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 let computers = Prelude.filter (\a -> pointType a == Computer) rps
mapM_ (\(ReachPoint _ icoord dir) -> do mapM_ (\(ReachPoint _ icoord dir) -> do
let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
@ -160,7 +188,10 @@ loadMapFork ud ad future progress = do
, objState = Just "off" , objState = Just "off"
} }
) (A.log A.Debug ("number of computers: " ++ show (length computers)) computers) ) (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 let toilets = Prelude.filter (\a -> pointType a == Toilet) rps
mapM_ (\(ReachPoint _ icoord dir) -> do mapM_ (\(ReachPoint _ icoord dir) -> do
let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
@ -172,7 +203,10 @@ loadMapFork ud ad future progress = do
, objType = Just ObjToilet , objType = Just ObjToilet
} }
) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets) ) (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 posbounds <- efor allEnts $ do
with pos with pos
with obstacle with obstacle
@ -193,7 +227,10 @@ loadMapFork ud ad future progress = do
, anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0 , anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
} }
) npcposs ) npcposs
void $ liftIO $ swapMVar progress (20 / loadSteps, "Handing over") liftIO $ modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Handing over"
)))
)) ad )) ad
putMVar future (nws, MainData putMVar future (nws, MainData
{ mapMat = mat { mapMat = mat