-- | Generation of caves (not yet inhabited dungeon levels) from cave kinds.
module Game.LambdaHack.Server.DungeonGen.Cave
  ( TileMapXY, ItemFloorXY, Cave(..), buildCave
  ) where

import Control.Arrow ((&&&))
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.List as L
import Data.Maybe

import qualified Game.LambdaHack.Common.Feature as F
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.PointXY
import Game.LambdaHack.Common.Random
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Content.CaveKind
import Game.LambdaHack.Content.PlaceKind
import Game.LambdaHack.Content.TileKind
import Game.LambdaHack.Server.DungeonGen.Area
import Game.LambdaHack.Server.DungeonGen.AreaRnd
import Game.LambdaHack.Server.DungeonGen.Place hiding (TileMapXY)
import qualified Game.LambdaHack.Server.DungeonGen.Place as Place
import Control.Exception.Assert.Sugar

-- | The map of tile kinds in a cave.
-- The map is sparse. The default tile that eventually fills the empty spaces
-- is specified in the cave kind specification with @cdefTile@.
type TileMapXY = Place.TileMapXY

-- | The map of starting items in tiles of a cave. The map is sparse.
-- Unspecified tiles have no starting items.
type ItemFloorXY = EM.EnumMap PointXY (Item, Int)

-- | The type of caves (not yet inhabited dungeon levels).
data Cave = Cave
  { dkind   :: !(Kind.Id CaveKind)  -- ^ the kind of the cave
  , dmap    :: !TileMapXY           -- ^ tile kinds in the cave
  , ditem   :: !ItemFloorXY         -- ^ starting items in the cave
  , dplaces :: ![Place]             -- ^ places generated in the cave
  , dnight  :: !Bool                -- ^ whether the cave is dark
  }
  deriving Show

{-
Rogue cave is generated by an algorithm inspired by the original Rogue,
as follows:

  * The available area is divided into a grid, e.g, 3 by 3,
    where each of the 9 grid cells has approximately the same size.

  * In each of the 9 grid cells one room is placed at a random position
    and with a random size, but larger than The minimum size,
    e.g, 2 by 2 floor tiles.

  * Rooms that are on horizontally or vertically adjacent grid cells
    may be connected by a corridor. Corridors consist of 3 segments of straight
    lines (either "horizontal, vertical, horizontal" or "vertical, horizontal,
    vertical"). They end in openings in the walls of the room they connect.
    It is possible that one or two of the 3 segments have length 0, such that
    the resulting corridor is L-shaped or even a single straight line.

  * Corridors are generated randomly in such a way that at least every room
    on the grid is connected, and a few more might be. It is not sufficient
    to always connect all adjacent rooms.
-}
-- TODO: fix identifier naming and split, after the code grows some more
-- | Cave generation by an algorithm inspired by the original Rogue,
buildCave :: Kind.COps         -- ^ content definitions
          -> Int               -- ^ depth of the level to generate
          -> Int               -- ^ maximum depth of the dungeon
          -> Kind.Id CaveKind  -- ^ cave kind to use for generation
          -> Rnd Cave
buildCave cops@Kind.COps{ cotile=cotile@Kind.Ops{ opick
                                                , ouniqGroup }
                        , cocave=Kind.Ops{okind}
                        , coplace=Kind.Ops{okind=pokind} }
          ln depth ci = do
  let kc@CaveKind{..} = okind ci
  lgrid@(gx, gy) <- castDiceXY cgrid
  -- Make sure that in caves not filled with rock, there is a passage
  -- across the cave, even if a single room blocks most of the cave.
  let fullArea = fromMaybe (assert `failure` kc)
                 $ toArea (0, 0, cxsize - 1, cysize - 1)
      subFullArea = fromMaybe (assert `failure` kc)
                    $ toArea (1, 1, cxsize - 2, cysize - 2)
      area | gx == 1 || gy == 1 = subFullArea
           | otherwise = fullArea
      gs = grid lgrid area
  (addedConnects, voidPlaces) <- do
    if gx * gy > 1 then do
       let fractionOfPlaces r = round $ r * fromIntegral (gx * gy)
           cauxNum = fractionOfPlaces cauxConnects
       addedC <- replicateM cauxNum (randomConnection lgrid)
       let gridArea = fromMaybe (assert `failure` lgrid)
                      $ toArea (0, 0, gx - 1, gy - 1)
           voidNum = fractionOfPlaces cmaxVoid
       voidPl <- replicateM voidNum $ xyInArea gridArea  -- repetitions are OK
       return (addedC, voidPl)
    else return ([], [])
  minPlaceSize <- castDiceXY cminPlaceSize
  maxPlaceSize <- castDiceXY cmaxPlaceSize
  places0 <- mapM (\ (i, r) -> do
                     -- Reserved for corridors and the global fence.
                     let innerArea = fromMaybe (assert `failure` (i, r))
                                     $ shrink r
                     r' <- if i `elem` voidPlaces
                           then fmap Left $ mkVoidRoom innerArea
                           else fmap Right $ mkRoom minPlaceSize
                                                    maxPlaceSize innerArea
                     return (i, r')) gs
  let hardRockId = ouniqGroup "outer fence"
      fence = buildFence hardRockId subFullArea
  dnight <- chanceDeep ln depth cnightChance
  darkCorTile <- fmap (fromMaybe $ assert `failure` cdarkCorTile)
                 $ opick cdarkCorTile (const True)
  litCorTile <- fmap (fromMaybe $ assert `failure` clitCorTile)
                $ opick clitCorTile (const True)
  let pickedCorTile = if dnight then darkCorTile else litCorTile
      addPl (m, pls, qls) (i, Left r) = return (m, pls, (i, Left r) : qls)
      addPl (m, pls, qls) (i, Right r) = do
        (tmap, place) <- buildPlace cops kc darkCorTile litCorTile ln depth r
        return (EM.union tmap m, place : pls, (i, Right (r, place)) : qls)
  (lplaces, dplaces, qplaces0) <- foldM addPl (fence, [], []) places0
  connects <- connectGrid lgrid
  let allConnects = L.union connects addedConnects  -- no duplicates
      qplaces = EM.fromList qplaces0
  cs <- mapM (\(p0, p1) -> do
                let shrinkPlace (r, Place{qkind}) =
                      case shrink r of
                        Nothing -> (r, r)  -- FNone place of x and/or y size 1
                        Just sr -> case pfence $ pokind qkind of
                          FFloor ->
                            -- Avoid corridors touching the floor fence,
                            -- but let them merge with the fence.
                            case shrink sr of
                              Nothing -> (sr, r)
                              Just mergeArea -> (mergeArea, r)
                          _ -> (sr, sr)
                    shrinkForFence = either (id &&& id) shrinkPlace
                    rr0 = shrinkForFence $ qplaces EM.! p0
                    rr1 = shrinkForFence $ qplaces EM.! p1
                connectPlaces rr0 rr1) allConnects
  let lcorridors = EM.unions (L.map (digCorridors pickedCorTile) cs)
      lm = EM.unionWith (mergeCorridor cotile) lcorridors lplaces
  -- Convert wall openings into doors, possibly.
  let f l (p, t) =
        if not $ Tile.hasFeature cotile F.Suspect t
        then return l  -- no opening to start with
        else do
          -- Openings have a certain chance to be doors
          -- and doors have a certain chance to be open.
          rd <- chance cdoorChance
          if not rd then
            return $ EM.insert p pickedCorTile l  -- opening kept
          else do
            ro <- chance copenChance
            doorClosedId <- Tile.revealAs cotile t
            if not ro then
              return $ EM.insert p doorClosedId l
            else do
              doorOpenId <- Tile.openTo cotile doorClosedId
              return $ EM.insert p doorOpenId l
  dmap <- foldM f lm (EM.assocs lm)
  let cave = Cave
        { dkind = ci
        , ditem = EM.empty
        , dmap
        , dplaces
        , dnight
        }
  return cave

digCorridors :: Kind.Id TileKind -> Corridor -> TileMapXY
digCorridors tile (p1:p2:ps) =
  EM.union corPos (digCorridors tile (p2:ps))
 where
  corXY  = fromTo p1 p2
  corPos = EM.fromList $ L.zip corXY (repeat tile)
digCorridors _ _ = EM.empty

mergeCorridor :: Kind.Ops TileKind -> Kind.Id TileKind -> Kind.Id TileKind
              -> Kind.Id TileKind
mergeCorridor cotile _ = Tile.hideAs cotile