layers-game-0.3: src/Level/Update.hs
module Level.Update where
#include "Utils.cpp"
import Control.Applicative ((<$>))
import qualified Data.List as L
import Data.Maybe (catMaybes)
import qualified Event as EV
import qualified GameData.Level as LV
import qualified GameData.Layer as LY
import qualified GameData.Boundary as BD
import qualified GameData.Entity as E
import qualified Entity.Update as EU
import qualified Entity.Intersect as EI
import qualified Level.ResolveIntersection as LR
IMPORT_LENS_AS_LE
update :: LV.Level -> LV.Level
update level = L.foldl' (\level isect ->
case LR.resolveIntersection isect level of
Just event -> EV.handleEvent event level
_ -> level)
level' isects
where
isects = intersections level'
level' = keepEntitiesInsideBoundary . updateEntities $ level
updateEntities :: LV.Level -> LV.Level
updateEntities level = updateEntities_ levelGravity level
where
levelGravity = LE.getL (LY.gravityL . LV.activeLayerL) level
updateEntities_ levelGravity level =
level {LV.entities = L.map (EU.update $ EU.UpdateState levelGravity) $ LV.entities level,
LV.layers = updateLayerEntities <$> LV.layers level}
updateLayerEntities layer@LY.Layer {LY.gravity = g} =
layer {LY.entities = L.map (EU.update $ EU.UpdateState g) $ LY.entities layer}
keepEntitiesInsideBoundary :: LV.Level -> LV.Level
keepEntitiesInsideBoundary level = E.eMap (`BD.keepInside` boundary) level
where
boundary = LV.boundary level
intersections :: LV.Level -> [EI.Intersection]
intersections level =
intersects levelEnts actLayerEnts ++ selfIntersects ([levelEnts, actLayerEnts] ++ inactLaysEnts)
where
selfIntersects = L.foldl' (\isects es -> isects ++ intersects es es) []
intersects entities1 entities2 =
catMaybes [EI.intersect e1 e2 | e1 <- entities1, e2 <- entities2]
levelEnts = LV.entities level
actLayerEnts = LE.getL (LY.entitiesL . LV.activeLayerL) level
inactLaysEnts = L.map LY.entities $ LV.inactiveLayers level