Level.hs

module GameData.Level where
#include "Utils.cpp"
import Control.Applicative ((<$>))
import Data.Function (on)
import qualified Data.List as L
import qualified Data.List.Zipper as LZ
import qualified Gamgine.Utils as GU
import qualified Gamgine.Zipper as GZ
import Gamgine.Control (applyIf)
import qualified Gamgine.Math.Vect as V
import Gamgine.Math.Vect
import qualified Gamgine.Math.Box as B
import qualified Gamgine.Math.BoxTree as BT
import qualified Entity.Bound as EB
import qualified Entity.Id as EI
import qualified GameData.Layer as LY
import qualified GameData.Entity as E
import qualified GameData.Player as PL
import qualified GameData.Boundary as BD
import qualified Rendering.Renderer as RD
IMPORT_LENS_AS_LE


data Level = Level {
   boundary  :: BD.Boundary,
   renderers :: [RD.Renderer],
   entities  :: [E.Entity],
   layers    :: LZ.Zipper LY.Layer
   }

LENS(boundary)
LENS(renderers)
LENS(entities)
LENS(layers)


instance E.ApplyToEntity Level where
   eMap f level = level {entities = E.eMap f $ entities level,
                         layers   = E.eMap f <$> layers level}

   eFilter p level = level {entities = E.eFilter p $ entities level,
                            layers   = E.eFilter p <$> layers level}


activeLayerL    = activeLayerLens
activeLayerLens = LE.lens getActiveLayer setActiveLayer
   where
      getActiveLayer       = LZ.cursor . layers
      setActiveLayer layer = LE.modL layersL $ LZ.replace layer


inactiveLayers :: Level -> [LY.Layer]
inactiveLayers level = before ++ after
   where
      before = LZ.toList . GZ.before . layers $ level
      after  = LZ.toList . GZ.after  . layers $ level


newLevel :: [E.Entity] -> [LY.Layer] -> Level
newLevel entities layers = Level boundary [] entities $ LZ.fromList layers
   where
      boundary    = BD.newBoundary allEntities
      allEntities = entities ++ (L.concat $ L.map LY.entities $ layers)


newEmptyLevel :: Level
newEmptyLevel =
   Level {boundary  = BD.Boundary $ B.Box V.nullVec (V.v3 2000 1000 0),
          renderers = [],
          entities  = [PL.newPlayer 0 (V.v3 1 1 0)],
          layers    = LZ.fromList [LY.newEmptyLayer, LY.newEmptyLayer]}


changeLevels :: Level -> Level -> (Level, Level)
changeLevels fromLevel toLevel =
   case findEntity E.isPlayer fromLevel of
        Just E.Player {E.playerVelocity = (vx:._)} ->
           (fromLevel, E.eMap (applyIf E.isPlayer $ \p -> p {E.playerVelocity = (vx:.0:.0)}) toLevel)

        _ -> (fromLevel, toLevel)


allLayers :: Level -> [LY.Layer]
allLayers = LZ.toList . layers


toNextLayer :: Level -> Level
toNextLayer = LE.modL layersL $ \lays -> applyIf LZ.endp LZ.start $ LZ.right lays


-- | the entities of the level and all its layers
allEntities :: Level -> [E.Entity]
allEntities Level {entities = entities, layers = layers} =
   entities ++ (L.concat $ L.map LY.entities $ LZ.toList layers)


findEntity :: (E.Entity -> Bool) -> Level -> Maybe E.Entity
findEntity f level = L.find f $ allEntities level

findEntityById id = findEntity $ (== id) . EI.entityId

findEntityAt pos = findEntity $ \e -> (BT.asBox . EB.bound $ e) `B.contains` pos


data AddEntityTo = ToLevel | ToActiveLayer

addEntity :: E.Entity -> AddEntityTo -> Level -> Level
addEntity entity ToLevel       = LE.modL entitiesL (entity :)
addEntity entity ToActiveLayer = LE.modL (LY.entitiesL . activeLayerL) (entity :)


freeEntityId :: Level -> Int
freeEntityId level = maxId + 1
   where
      maxId | L.null allIds = 0
            | otherwise     = L.maximum allIds

      allIds = L.map EI.entityId (allEntities level)


allStarsCollected :: Level -> Bool
allStarsCollected = L.all (== True) . L.map E.starCollected . L.filter E.isStar . allEntities


-- | a lens for the player entity
playerL    = playerLens
playerLens = LE.lens getPlayer setPlayer
   where
      getPlayer = \level ->
         case findEntity E.isPlayer level of
              Just p -> p
              _      -> error $ "Couldn't find player!"

      setPlayer = \player level -> E.eMap (set player) level
         where
            set player E.Player {} = player
            set _      e           = e