content: -- | Inhabited dungeon levels and the operations to query and change them
  -- as the game progresses.
  module Game.LambdaHack.Common.Level
    ( -- * Dungeon
      Dungeon, dungeonBounds, ascendInBranch, whereTo
      -- * The @Level@ type and its components
    , ItemFloor, BigActorMap, ProjectileMap, TileMap, SmellMap, Level(..)
      -- * Component updates
    , updateFloor, updateEmbed, updateBigMap, updateProjMap
    , updateTile, updateEntry, updateSmell
      -- * Level query
    , at
    , posToBigLvl, occupiedBigLvl, posToProjsLvl, occupiedProjLvl, posToAidsLvl
    , findPosTry, findPosTry2, nearbyPassablePoints, nearbyFreePoints
      -- * Misc
    , sortEmbeds
  #ifdef EXPOSE_INTERNAL
      -- * Internal operations
    , EntryMap
    , assertSparseItems, assertSparseProjectiles
  #endif
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import           Data.Binary
  import qualified Data.EnumMap.Strict as EM
  import qualified Data.EnumSet as ES
  
  import           Game.LambdaHack.Common.Area
  import           Game.LambdaHack.Common.Item
  import           Game.LambdaHack.Common.Kind
  import           Game.LambdaHack.Common.Point
  import qualified Game.LambdaHack.Common.PointArray as PointArray
  import qualified Game.LambdaHack.Common.Tile as Tile
  import           Game.LambdaHack.Common.Time
  import           Game.LambdaHack.Common.Types
  import           Game.LambdaHack.Common.Vector
  import           Game.LambdaHack.Content.CaveKind (CaveKind)
  import qualified Game.LambdaHack.Content.ItemKind as IK
  import           Game.LambdaHack.Content.PlaceKind
  import           Game.LambdaHack.Content.RuleKind
  import           Game.LambdaHack.Content.TileKind (TileKind)
  import qualified Game.LambdaHack.Core.Dice as Dice
  import           Game.LambdaHack.Core.Random
  import           Game.LambdaHack.Definition.Defs
  
  -- | The complete dungeon is a map from level identifiers to levels.
  type Dungeon = EM.EnumMap LevelId Level
  
  dungeonBounds :: Dungeon -> (LevelId, LevelId)
  dungeonBounds dungeon
    | Just ((s, _), _) <- EM.minViewWithKey dungeon
    , Just ((e, _), _) <- EM.maxViewWithKey dungeon
    = (s, e)
  dungeonBounds dungeon = error $ "empty dungeon" `showFailure` dungeon
  
  -- | Levels in the current branch, one level up (or down) from the current.
  ascendInBranch :: Dungeon -> Bool -> LevelId -> [LevelId]
  ascendInBranch dungeon up lid =
    -- Currently there is just one branch, so the computation is simple.
    let (minD, maxD) = dungeonBounds dungeon
        ln = max minD $ min maxD $ toEnum $ fromEnum lid + if up then 1 else -1
    in case EM.lookup ln dungeon of
      Just _ | ln /= lid -> [ln]
      _ | ln == lid -> []
      _ -> ascendInBranch dungeon up ln  -- jump over gaps
  
  -- | Compute the level identifier and stair position on the new level,
  -- after a level change.
  --
  -- We assume there is never a staircase up and down at the same position.
  whereTo :: LevelId             -- ^ level of the stairs
          -> Point               -- ^ position of the stairs
          -> Bool                -- ^ optional forced direction
          -> Dungeon             -- ^ current game dungeon
          -> [(LevelId, Point)]  -- ^ possible destinations
  whereTo lid pos up dungeon =
    let lvl = dungeon EM.! lid
        li = case elemIndex pos $ fst $ lstair lvl of
          Just ifst -> assert up [ifst]
          Nothing -> case elemIndex pos $ snd $ lstair lvl of
            Just isnd -> assert (not up) [isnd]
            Nothing ->
              let forcedPoss = (if up then fst else snd) (lstair lvl)
              in [0 .. length forcedPoss - 1]  -- for ascending via, e.g., spells
    in case ascendInBranch dungeon up lid of
      [] -> []  -- spell fizzles
      ln : _ -> let lvlDest = dungeon EM.! ln
                    stairsDest = (if up then snd else fst) (lstair lvlDest)
                    posAtIndex i = case drop i stairsDest of
                      [] -> error $ "not enough stairs:" `showFailure` (ln, i + 1)
                      p : _ -> (ln, p)
                in map posAtIndex li
  
  -- | Items located on map tiles.
  type ItemFloor = EM.EnumMap Point ItemBag
  
  -- | Big actors located on map tiles.
  type BigActorMap = EM.EnumMap Point ActorId
  
  -- | Collections of projectiles located on map tiles.
  type ProjectileMap = EM.EnumMap Point [ActorId]
  
  -- | Tile kinds on the map.
  type TileMap = PointArray.Array (ContentId TileKind)
  
  -- | Current smell on map tiles.
  type SmellMap = EM.EnumMap Point Time
  
  -- | Entries of places on the map.
  type EntryMap = EM.EnumMap Point PlaceEntry
  
  -- | A view on single, inhabited dungeon level. "Remembered" fields
  -- carry a subset of the info in the client copies of levels.
  data Level = Level
    { lkind   :: ContentId CaveKind
                            -- ^ the kind of cave the level is an instance of
    , ldepth  :: Dice.AbsDepth
                            -- ^ absolute depth of the level
    , lfloor  :: ItemFloor  -- ^ remembered items lying on the floor
    , lembed  :: ItemFloor  -- ^ remembered items embedded in the tile
    , lbig    :: BigActorMap
                            -- ^ seen big (non-projectile) actors at positions
                            --   on the level;
                            --   could be recomputed at resume, but small enough
    , lproj   :: ProjectileMap
                            -- ^ seen projectiles at positions on the level;
                            --   could be recomputed at resume
    , ltile   :: TileMap    -- ^ remembered level map
    , lentry  :: EntryMap   -- ^ room entrances on the level
    , larea   :: Area       -- ^ area of the level
    , lsmell  :: SmellMap   -- ^ remembered smells on the level
    , lstair  :: ([Point], [Point])
                            -- ^ positions of (up, down) stairs
    , lescape :: [Point]    -- ^ positions of IK.Escape tiles
    , lseen   :: Int        -- ^ currently remembered clear tiles
    , lexpl   :: Int        -- ^ total number of explorable tiles
    , ltime   :: Time       -- ^ local time on the level (possibly frozen)
    , lnight  :: Bool       -- ^ whether the level is covered in darkness
    }
    deriving (Show, Eq)
  
  assertSparseItems :: ItemFloor -> ItemFloor
  assertSparseItems m =
    assert (EM.null (EM.filter EM.null m)
            `blame` "null floors found" `swith` m) m
  
  hashConsSingle :: ItemFloor -> ItemFloor
  hashConsSingle =
    EM.map (EM.map (\case
                      (1, []) -> quantSingle
                      kit -> kit))
  
  assertSparseProjectiles :: ProjectileMap -> ProjectileMap
  assertSparseProjectiles m =
    assert (EM.null (EM.filter null m)
            `blame` "null projectile lists found" `swith` m) m
  
  updateFloor :: (ItemFloor -> ItemFloor) -> Level -> Level
  {-# INLINE updateFloor #-}  -- just in case inliner goes hiwire
  updateFloor f lvl = lvl {lfloor = f (lfloor lvl)}
  
  updateEmbed :: (ItemFloor -> ItemFloor) -> Level -> Level
  updateEmbed f lvl = lvl {lembed = f (lembed lvl)}
  
  updateBigMap :: (BigActorMap -> BigActorMap) -> Level -> Level
  updateBigMap f lvl = lvl {lbig = f (lbig lvl)}
  
  updateProjMap :: (ProjectileMap -> ProjectileMap) -> Level -> Level
  {-# INLINE updateProjMap #-}
  updateProjMap f lvl = lvl {lproj = f (lproj lvl)}
  
  updateTile :: (TileMap -> TileMap) -> Level -> Level
  updateTile f lvl = lvl {ltile = f (ltile lvl)}
  
  updateEntry :: (EntryMap -> EntryMap) -> Level -> Level
  updateEntry f lvl = lvl {lentry = f (lentry lvl)}
  
  updateSmell :: (SmellMap -> SmellMap) -> Level -> Level
  updateSmell f lvl = lvl {lsmell = f (lsmell lvl)}
  
  -- | Query for tile kinds on the map.
  at :: Level -> Point -> ContentId TileKind
  {-# INLINE at #-}
  at Level{ltile} p = ltile PointArray.! p
  
  posToBigLvl :: Point -> Level -> Maybe ActorId
  {-# INLINE posToBigLvl #-}
  posToBigLvl pos lvl = EM.lookup pos $ lbig lvl
  
  occupiedBigLvl :: Point -> Level -> Bool
  {-# INLINE occupiedBigLvl #-}
  occupiedBigLvl pos lvl = pos `EM.member` lbig lvl
  
  posToProjsLvl :: Point -> Level -> [ActorId]
  {-# INLINE posToProjsLvl #-}
  posToProjsLvl pos lvl = EM.findWithDefault [] pos $ lproj lvl
  
  occupiedProjLvl :: Point -> Level -> Bool
  {-# INLINE occupiedProjLvl #-}
  occupiedProjLvl pos lvl = pos `EM.member` lproj lvl
  
  posToAidsLvl :: Point -> Level -> [ActorId]
  {-# INLINE posToAidsLvl #-}
  posToAidsLvl pos lvl = maybeToList (posToBigLvl pos lvl)
                         ++ posToProjsLvl pos lvl
  
  -- | Try to find a random position on the map satisfying
  -- conjunction of the mandatory and an optional predicate.
  -- If the permitted number of attempts is not enough,
  -- try again the same number of times without the next optional predicate,
  -- and fall back to trying with only the mandatory predicate.
  findPosTry :: Int                                    -- ^ the number of tries
             -> Level                                  -- ^ look up in this level
             -> (Point -> ContentId TileKind -> Bool)  -- ^ mandatory predicate
             -> [Point -> ContentId TileKind -> Bool]  -- ^ optional predicates
             -> Rnd (Maybe Point)
  {-# INLINE findPosTry #-}
  findPosTry numTries lvl m = findPosTry2 numTries lvl m [] undefined
  
  findPosTry2 :: Int                                    -- ^ the number of tries
              -> Level                                  -- ^ look up in this level
              -> (Point -> ContentId TileKind -> Bool)  -- ^ mandatory predicate
              -> [Point -> ContentId TileKind -> Bool]  -- ^ optional predicates
              -> (Point -> ContentId TileKind -> Bool)  -- ^ good to have pred.
              -> [Point -> ContentId TileKind -> Bool]  -- ^ worst case predicates
              -> Rnd (Maybe Point)
  {-# INLINE findPosTry2 #-}
  findPosTry2 numTries Level{ltile, larea} m0 l g r =
    assert (numTries > 0) $
    let (Point x0 y0, xspan, yspan) = spanArea larea
        accomodate :: Rnd (Maybe Point)
                   -> (Point -> ContentId TileKind -> Bool)
                   -> [Point -> ContentId TileKind -> Bool]
                   -> Rnd (Maybe Point)
        {-# INLINE accomodate #-}
        accomodate fallback m = go
         where
          go :: [Point -> ContentId TileKind -> Bool]
             -> Rnd (Maybe Point)
          go [] = fallback
          go (hd : tl) = search numTries
           where
            search 0 = go tl
            search !k = do
              pxyRelative <- randomR0 (xspan * yspan - 1)
              -- Here we can't use @fromEnum@ and/or work with the @Int@
              -- representation, because the span is different than @rWidthMax@.
              let Point{..} = punindex xspan pxyRelative
                  pos = Point (x0 + px) (y0 + py)
                  tile = ltile PointArray.! pos
              if m pos tile && hd pos tile
              then return $ Just pos
              else search (k - 1)
        rAndOnceOnlym0 = r ++ [\_ _ -> True]
    in accomodate (accomodate (return Nothing) m0 rAndOnceOnlym0)
                  -- @pos@ and @tile@ not always needed, so not strict;
                  -- the function arguments determine that thanks to inlining.
                  (\pos tile -> m0 pos tile && g pos tile)
                  l
  
  -- | Generate a list of all passable points on (connected component of)
  -- the level in the order of path distance from the starting position (BFS).
  -- The starting position needn't be passable and is always included.
  nearbyPassablePoints :: COps -> Level -> Point -> [Point]
  nearbyPassablePoints cops@COps{corule=RuleContent{rWidthMax, rHeightMax}}
                       lvl start =
    let passable p = Tile.isEasyOpen (coTileSpeedup cops) (lvl `at` p)
        -- The error is mostly probably caused by place content creating
        -- enclosed spaces in conjunction with map edges. To verify,
        -- change the error to @l@ and run with the same seed.
        semiRandomWrap l = if null l then error "nearbyPassablePoints: blocked"
                           else let offset = fromEnum start `mod` length l
                                in drop offset l ++ take offset l
        passableVic p = semiRandomWrap $ filter passable
                        $ vicinityBounded rWidthMax rHeightMax p
        siftSingle :: Point
                   -> (ES.EnumSet Point, [Point])
                   -> (ES.EnumSet Point, [Point])
        siftSingle current (seen, sameDistance) =
          if current `ES.member` seen
          then (seen, sameDistance)
          else (ES.insert current seen, current : sameDistance)
        siftVicinity :: Point
                     -> (ES.EnumSet Point, [Point])
                     -> (ES.EnumSet Point, [Point])
        siftVicinity current seenAndSameDistance =
          let vic = passableVic current
          in foldr siftSingle seenAndSameDistance vic
        siftNearby :: (ES.EnumSet Point, [Point]) -> [Point]
        siftNearby (seen, sameDistance) =
          sameDistance
          ++ case foldr siftVicinity (seen, []) sameDistance of
               (_, []) -> []
               (seen2, sameDistance2) -> siftNearby (seen2, sameDistance2)
    in siftNearby (ES.singleton start, [start])
  
  nearbyFreePoints :: COps -> Level -> (ContentId TileKind -> Bool) -> Point
                   -> [Point]
  nearbyFreePoints cops lvl f start =
    let good p = f (lvl `at` p)
                 && Tile.isWalkable (coTileSpeedup cops) (lvl `at` p)
                 && null (posToAidsLvl p lvl)
    in filter good $ nearbyPassablePoints cops lvl start
  
  -- We ignore stray embeds, not mentioned in the tile kind.
  -- OTOH, some of those mentioned may be used up and so not in the bag
  -- and it's OK.
  sortEmbeds :: COps -> ContentId TileKind -> [(IK.ItemKind, (ItemId, ItemQuant))]
             -> [(ItemId, ItemQuant)]
  sortEmbeds COps{cotile} tk embedKindList =
    let grpList = Tile.embeddedItems cotile tk
        -- Greater or equal 0 to also cover template UNKNOWN items
        -- not yet identified by the client.
        f grp (itemKind, _) = fromMaybe (-1) (lookup grp $ IK.ifreq itemKind) >= 0
    in map snd $ mapMaybe (\grp -> find (f grp) embedKindList) grpList
  
  instance Binary Level where
    put Level{..} = do
      put lkind
      put ldepth
      put (assertSparseItems lfloor)
      put (assertSparseItems lembed)
      put lbig
      put (assertSparseProjectiles lproj)
      put ltile
      put lentry
      put larea
      put lsmell
      put lstair
      put lescape
      put lseen
      put lexpl
      put ltime
      put lnight
    get = do
      lkind <- get
      ldepth <- get
      lfloor <- hashConsSingle <$> get
      lembed <- hashConsSingle <$> get
      lbig <- get
      lproj <- get
      ltile <- get
      lentry <- get
      larea <- get
      lsmell <- get
      lstair <- get
      lescape <- get
      lseen <- get
      lexpl <- get
      ltime <- get
      lnight <- get
      return $! Level{..}
  