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

import Control.Arrow ((&&&))
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Traversable as Traversable

import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Point
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

-- | The type of caves (not yet inhabited dungeon levels).
data Cave = Cave
  { dkind   :: !(Kind.Id CaveKind)  -- ^ the kind of the cave
  , dmap    :: !TileMapEM           -- ^ tile kinds 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}
                        , cocave=Kind.Ops{okind}
                        , coplace=Kind.Ops{okind=pokind} }
          ln depth dkind = do
  let kc@CaveKind{..} = okind dkind
  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.
  -- Also, ensure fancy outer fences are not obstructed by room walls.
  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 * gy == 1
             || couterFenceTile /= "basic outer fence" = 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
  fence <- buildFenceRnd cops couterFenceTile 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 dnight 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 = union connects addedConnects  -- no duplicates
      qplaces = M.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 M.! p0
                    rr1 = shrinkForFence $ qplaces M.! p1
                connectPlaces rr0 rr1) allConnects
  let lcorridors = EM.unions (map (digCorridors pickedCorTile) cs)
      lm = EM.unionWith (mergeCorridor cotile) lcorridors lplaces
  -- Convert wall openings into doors, possibly.
  let f t =
        if not $ Tile.isSuspect cotile t
          -- May also turn a cache into a floor (and/or a pillar?); tough luck.
          -- TODO: the floor may be lit while it should be dark.
        then return t  -- 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
            let cor = if Tile.isLit cotile t then litCorTile else darkCorTile
            in return $! cor  -- opening kept
          else do
            ro <- chance copenChance
            doorClosedId <- Tile.revealAs cotile t
            if not ro then
              return $! doorClosedId
            else do
              doorOpenId <- Tile.openTo cotile doorClosedId
              return $! doorOpenId
  dmap <- Traversable.mapM f lm
  let cave = Cave
        { dkind
        , dmap
        , dplaces
        , dnight
        }
  return $! cave

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

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