Block screen during long loading

src/Dodge/Update.hs

@@ -65,7 +65,8 @@ import qualified IntMapHelp as IM
 import LensHelp
 import SDL
 import Sound.Data
-import StrictHelp
+
+--import StrictHelp
 
 updateUniverse :: Universe -> Universe
 updateUniverse u =
@@ -103,8 +104,8 @@ mouseClickOptionsList screen u = fromMaybe u $ do
 
 mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe
 mouseOverSelectionList ldps sl u
-    | x > xl && x < xr 
-        && ylower == yupper 
+    | x > xl && x < xr
+        && ylower == yupper
         && mmoving
         && ylower >= 0
         && ylower < ymax
@@ -179,6 +180,7 @@ updateUniverseLast =
 {- For most menus the only way to change the world is using event handling.  -}
 updateUniverseMid :: Universe -> Universe
 updateUniverseMid u = case _uvScreenLayers u of
+    (OptionScreen{_scOptionFlag = LoadingScreen} : _) -> u
     (OptionScreen{_scOptionFlag = GameOverOptions} : _) ->
         u & uvWorld
             %~ (
@@ -268,7 +270,6 @@ functionalUpdate w =
         . over uvWorld updateFlames
         . over uvWorld updateShockwaves
         . over uvWorld updateEnergyBalls
-        --    . over uvWorld updateParticles
         . over uvWorld updateBullets
         . over uvWorld updateRadarBlips
         . over uvWorld updateFlares
@@ -298,7 +299,7 @@ functionalUpdate w =
         . over uvWorld updateCloseObjects
         . over uvWorld updateWheelEvents
         -- . over uvWorld updateInventorySelectionList
-        $ over uvWorld updatePastWorlds w
+        $ over (uvWorld . cWorld) updatePastWorlds w
 
 --updateInventorySelectionList :: World -> World
 --updateInventorySelectionList w = w
@@ -334,10 +335,9 @@ advanceScrollAmount u =
         & uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u)
         & uvWorld . input . scrollAmount .~ 0
 
-updatePastWorlds :: World -> World
-updatePastWorlds w = w & cWorld . pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
-
---updatePastWorlds w = w & cWorld . pastWorlds .~ []
+updatePastWorlds :: CWorld -> CWorld
+--updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld) :))
+updatePastWorlds w = w & pastWorlds .~ []
 
 moveHammersUp :: Universe -> Universe
 --moveHammersUp = uvWorld . hammers .~ M.empty
@@ -494,52 +494,48 @@ updateObjCatMaybes p f w = w' & cWorld . lWorld . p #~ catMaybes newxs
 updateDistortions :: World -> World
 updateDistortions = updateObjMapMaybe distortions updateDistortion
 
---updateDistortions = cWorld . lWorld . distortions %~ mapMaybe updateDistortion
-
 updateLightSources :: World -> World
 updateLightSources = updateObjMapMaybe tempLightSources (\b -> updateTempLightSource (_tlsUpdate b) b)
 
-updateTeslaArcs :: World -> World
-updateTeslaArcs = updateObjCatMaybes teslaArcs moveTeslaArc
-
 updateRadarBlips :: World -> World
 updateRadarBlips = updateObjMapMaybe radarBlips updateRadarBlip
 
 updateFlares :: World -> World
 updateFlares = updateObjMapMaybe flares updateFlare
 
-updateTractorBeams :: World -> World
-updateTractorBeams = updateObjCatMaybes tractorBeams updateTractorBeam
-
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateBullets :: World -> World
 updateBullets w = updateInstantBullets $ set (cWorld . lWorld . bullets) (catMaybes ps) w'
   where
     (w', ps) = mapAccumR updateBullet w $ w ^. cWorld . lWorld . bullets
 
+updateTeslaArcs :: World -> World
+updateTeslaArcs = updateObjCatMaybes teslaArcs updateTeslaArc
+
+updateTractorBeams :: World -> World
+updateTractorBeams = updateObjCatMaybes tractorBeams updateTractorBeam
+
 updateShockwaves :: World -> World
 updateShockwaves = updateObjCatMaybes shockwaves updateShockwave
 
 updateFlames :: World -> World
-updateFlames = updateObjCatMaybes flames moveFlame
+updateFlames = updateObjCatMaybes flames updateFlame
 
 updateEnergyBalls :: World -> World
-updateEnergyBalls = updateObjCatMaybes energyBalls moveEnergyBall
+updateEnergyBalls = updateObjCatMaybes energyBalls updateEnergyBall
 
 updateRadarSweeps :: World -> World
 updateRadarSweeps = updateObjCatMaybes radarSweeps updateRadarSweep
 
 updateSparks :: World -> World
-updateSparks = updateObjCatMaybes sparks moveSpark
+updateSparks = updateObjCatMaybes sparks updateSpark
 
 updatePosEvents :: World -> World
 updatePosEvents = updateObjCatMaybes posEvents updatePosEvent
 
-{- Apply internal particle updates, delete 'Nothing's.  -}
---updateParticles :: World -> World
---updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
---  where
---    (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w
+updateClouds :: World -> World
+updateClouds = updateObjCatMaybes clouds updateCloud
+
 updateBeams :: World -> World
 updateBeams w =
     w
@@ -683,9 +679,6 @@ mvGust _ gu
                 & guPos .+.+~ _guVel gu
                 & guTime -~ 1
 
-updateClouds :: World -> World
-updateClouds = updateObjCatMaybes clouds updateCloud
-
 cloudEffect :: Cloud -> World -> World
 cloudEffect cl = case _clType cl of
     GasCloud -> cloudPoisonDamage cl