Cleanup

src/Dodge/Update.hs

@@ -2,9 +2,7 @@
 Module      : Dodge.Update
 Description : Simulation update
 -}
-module Dodge.Update 
-    ( updateUniverse
-    ) where
+module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
 import Dodge.Menu
 import Dodge.Hammer
@@ -38,7 +36,7 @@ updateUniverse u = case _menuLayers u of
         | otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail )
     (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~
         ( updateParticles 
-        . updateProjectiles 
+        . updateIMl _props _pjUpdate 
         . updateLightSources
         . updateClouds )
     (_ : _) -> u
@@ -48,44 +46,47 @@ updateUniverse u = case _menuLayers u of
 functionalUpdate :: Configuration -> World -> World
 functionalUpdate cfig w = checkEndGame 
     . (worldClock +~ 1)
-     . updateDistortions
-     . updateCreatureSoundPositions
-     . ppEvents
-     . updateCamera cfig
-     . colCrsWalls cfig
---     . ifConfigWallRotate
-     . simpleCrSprings 
-     . zoneCreatures 
-     . updateDoors
+    . updateDistortions
+    . updateCreatureSoundPositions
+    . ppEvents
+    . updateCamera cfig
+    . colCrsWalls cfig
+    . simpleCrSprings 
+    . zoneCreatures 
+    . updateIMl _doors _drMech
     . updateDelayedEvents
-     . resetWorldEvents
-     . dbArg _worldEvents
-     . updateModifications
-     . updateParticles 
-     . updateProjectiles 
-     . updateLightSources
-     . updateClouds
-     . zoneClouds
-     . updateMachines
-     . updateCreatures 
-     . updateCreatureGroups
-     . updateBlocks
-     . updateSeenWalls 
-     . (lSelHammerPosition %~ moveHammerUp)
-     $ updateCloseObjects w
+    . resetWorldEvents
+    . dbArg _worldEvents
+    . updateIMl _modifications _mdUpdate
+    . updateParticles 
+    . updateIMl _props _pjUpdate  
+    . updateLightSources
+    . updateClouds
+    . zoneClouds
+    . updateIMl _machines _mcUpdate
+    . updateCreatures 
+    . updateCreatureGroups
+    . updateBlocks
+    . updateSeenWalls 
+    . (lSelHammerPosition %~ moveHammerUp)
+    $ updateCloseObjects w
   where 
     --updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w
-    zoneCreatures = set (creaturesZone . znObjects) 
-        (IM.foldl' (flip creatureInZone) IM.empty (_creatures w))
-    creatureInZone cr = insertIMInZone x y cid cr
-      where 
-        (x,y) = crZoneOfPoint $ _crPos cr
-        cid = _crID cr
     zoneClouds = set (cloudsZone . znObjects) (foldl' (flip cloudInZone) IM.empty (_clouds w))
     cloudInZone cl = insertInZoneWith x y (++) [cl]
       where 
         (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl
 
+zoneCreatures :: World -> World
+zoneCreatures w = w 
+    & creaturesZone . znObjects .~
+        IM.foldl' (flip creatureInZone) IM.empty (_creatures w)
+  where
+    creatureInZone cr = insertIMInZone x y cid cr
+      where 
+        (x,y) = crZoneOfPoint $ _crPos cr
+        cid = _crID cr
+
 updateCreatureSoundPositions :: World -> World
 updateCreatureSoundPositions w = M.foldrWithKey insertSound w 
     . M.mapMaybeWithKey updateSound 
@@ -97,8 +98,10 @@ updateCreatureSoundPositions w = M.foldrWithKey insertSound w
         Nothing -> Just s {_soundTime = Just 0}
     updateSound _ _ = Nothing
 
-updateModifications :: World -> World
-updateModifications w = foldr (dbArg _mdUpdate) w (_modifications w)
+--updateIMr :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
+--updateIMr fim fup w = foldr (dbArg fup) w (fim w)
+updateIMl :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
+updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
 
 updateBlocks :: World -> World
 updateBlocks w = foldr f w $ _blocks w
@@ -124,9 +127,6 @@ updateLightSources w = over tempLightSources f w
   where 
     f = mapMaybe (\b -> _tlsUpdate b w b)
 
-updateProjectiles :: World -> World
-updateProjectiles w = IM.foldl' (flip $ dbArg _pjUpdate) w $ _props w
-
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateParticles :: World -> World
 updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'