-- | The type of cave kinds. Every level in the game is an instantiated
-- cave kind.
module Game.LambdaHack.Content.CaveKind
  ( pattern DEFAULT_RANDOM
  , CaveKind(..), InitSleep(..), makeData
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateSingle, validateAll, mandatoryGroups
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Text as T

import           Game.LambdaHack.Content.ItemKind (ItemKind)
import           Game.LambdaHack.Content.PlaceKind (PlaceKind)
import qualified Game.LambdaHack.Content.RuleKind as RK
import           Game.LambdaHack.Content.TileKind (TileKind)
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Random
import           Game.LambdaHack.Definition.ContentData
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.DefsInternal

-- | Parameters for the generation of dungeon levels.
-- Warning: for efficiency, avoid embedded items in any of the common tiles.
data CaveKind = CaveKind
  { CaveKind -> Text
cname         :: Text             -- ^ short description
  , CaveKind -> Freqs CaveKind
cfreq         :: Freqs CaveKind   -- ^ frequency within groups
  , CaveKind -> Int
cXminSize     :: X                -- ^ minimal X size of the whole cave
  , CaveKind -> Int
cYminSize     :: Y                -- ^ minimal Y size of the whole cave
  , CaveKind -> DiceXY
ccellSize     :: Dice.DiceXY      -- ^ size of a map cell holding a place
  , CaveKind -> DiceXY
cminPlaceSize :: Dice.DiceXY      -- ^ minimal size of places; for merging
  , CaveKind -> DiceXY
cmaxPlaceSize :: Dice.DiceXY      -- ^ maximal size of places; for growing
  , CaveKind -> Dice
cdarkOdds     :: Dice.Dice        -- ^ the odds a place is dark
                                      --   (level-scaled dice roll > 50)
  , CaveKind -> Dice
cnightOdds    :: Dice.Dice        -- ^ the odds the cave is dark
                                      --   (level-scaled dice roll > 50)
  , CaveKind -> Rational
cauxConnects  :: Rational         -- ^ a proportion of extra connections
  , CaveKind -> Rational
cmaxVoid      :: Rational
      -- ^ at most this proportion of rooms may be void
  , CaveKind -> Rational
cdoorChance   :: Chance           -- ^ the chance of a door in an opening
  , CaveKind -> Rational
copenChance   :: Chance           -- ^ if there's a door, is it open?
  , CaveKind -> Int
chidden       :: Int              -- ^ if not open, hidden one in n times
  , CaveKind -> Int
cactorCoeff   :: Int              -- ^ the lower, the more monsters spawn
  , CaveKind -> Freqs ItemKind
cactorFreq    :: Freqs ItemKind   -- ^ actor groups to consider
  , CaveKind -> Dice
citemNum      :: Dice.Dice        -- ^ number of initial items in the cave
  , CaveKind -> Freqs ItemKind
citemFreq     :: Freqs ItemKind   -- ^ item groups to consider;
      -- note that the groups are flattened; e.g., if an item is moved
      -- to another included group with the same weight, the outcome
      -- doesn't change
  , CaveKind -> Freqs PlaceKind
cplaceFreq    :: Freqs PlaceKind  -- ^ place groups to consider
  , CaveKind -> Bool
cpassable     :: Bool
      -- ^ are passable default tiles permitted
  , CaveKind -> Bool
clabyrinth    :: Bool                -- ^ waste of time for AI to explore
  , CaveKind -> GroupName TileKind
cdefTile      :: GroupName TileKind  -- ^ the default cave tile
  , CaveKind -> GroupName TileKind
cdarkCorTile  :: GroupName TileKind  -- ^ the dark cave corridor tile
  , CaveKind -> GroupName TileKind
clitCorTile   :: GroupName TileKind  -- ^ the lit cave corridor tile
  , CaveKind -> GroupName TileKind
cwallTile     :: GroupName TileKind  -- ^ the tile used for @FWall@ fence
  , CaveKind -> GroupName TileKind
ccornerTile   :: GroupName TileKind  -- ^ tile used for the fence corners
  , CaveKind -> GroupName TileKind
cfenceTileN   :: GroupName TileKind  -- ^ the outer fence N wall
  , CaveKind -> GroupName TileKind
cfenceTileE   :: GroupName TileKind  -- ^ the outer fence E wall
  , CaveKind -> GroupName TileKind
cfenceTileS   :: GroupName TileKind  -- ^ the outer fence S wall
  , CaveKind -> GroupName TileKind
cfenceTileW   :: GroupName TileKind  -- ^ the outer fence W wall
  , CaveKind -> Bool
cfenceApart   :: Bool                -- ^ are places touching fence banned
  , CaveKind -> Int
cminStairDist :: Int                 -- ^ minimal distance between stairs
  , CaveKind -> Dice
cmaxStairsNum :: Dice.Dice           -- ^ maximum number of stairs
  , CaveKind -> Freqs PlaceKind
cescapeFreq   :: Freqs PlaceKind     -- ^ escape groups, if any
  , CaveKind -> Freqs PlaceKind
cstairFreq    :: Freqs PlaceKind     -- ^ place groups for created stairs
  , CaveKind -> Freqs PlaceKind
cstairAllowed :: Freqs PlaceKind     -- ^ extra groups for inherited
  , CaveKind -> [Int]
cskip         :: [Int]  -- ^ which faction starting positions to skip
  , CaveKind -> InitSleep
cinitSleep    :: InitSleep           -- ^ whether actors spawn sleeping
  , CaveKind -> Text
cdesc         :: Text   -- ^ full cave description
  }
  deriving Int -> CaveKind -> ShowS
[CaveKind] -> ShowS
CaveKind -> String
(Int -> CaveKind -> ShowS)
-> (CaveKind -> String) -> ([CaveKind] -> ShowS) -> Show CaveKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CaveKind -> ShowS
showsPrec :: Int -> CaveKind -> ShowS
$cshow :: CaveKind -> String
show :: CaveKind -> String
$cshowList :: [CaveKind] -> ShowS
showList :: [CaveKind] -> ShowS
Show  -- No Eq and Ord to make extending logically sound

data InitSleep = InitSleepAlways | InitSleepPermitted | InitSleepBanned
  deriving (Int -> InitSleep -> ShowS
[InitSleep] -> ShowS
InitSleep -> String
(Int -> InitSleep -> ShowS)
-> (InitSleep -> String)
-> ([InitSleep] -> ShowS)
-> Show InitSleep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitSleep -> ShowS
showsPrec :: Int -> InitSleep -> ShowS
$cshow :: InitSleep -> String
show :: InitSleep -> String
$cshowList :: [InitSleep] -> ShowS
showList :: [InitSleep] -> ShowS
Show, InitSleep -> InitSleep -> Bool
(InitSleep -> InitSleep -> Bool)
-> (InitSleep -> InitSleep -> Bool) -> Eq InitSleep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitSleep -> InitSleep -> Bool
== :: InitSleep -> InitSleep -> Bool
$c/= :: InitSleep -> InitSleep -> Bool
/= :: InitSleep -> InitSleep -> Bool
Eq)

-- | Catch caves with not enough space for all the places. Check the size
-- of the cave descriptions to make sure they fit on screen. Etc.
validateSingle :: RK.RuleContent -> CaveKind -> [Text]
validateSingle :: RuleContent -> CaveKind -> [Text]
validateSingle RuleContent
corule CaveKind{Bool
Int
[Int]
Freqs ItemKind
Freqs PlaceKind
Freqs CaveKind
Rational
Text
DiceXY
Dice
GroupName TileKind
InitSleep
cname :: CaveKind -> Text
cfreq :: CaveKind -> Freqs CaveKind
cXminSize :: CaveKind -> Int
cYminSize :: CaveKind -> Int
ccellSize :: CaveKind -> DiceXY
cminPlaceSize :: CaveKind -> DiceXY
cmaxPlaceSize :: CaveKind -> DiceXY
cdarkOdds :: CaveKind -> Dice
cnightOdds :: CaveKind -> Dice
cauxConnects :: CaveKind -> Rational
cmaxVoid :: CaveKind -> Rational
cdoorChance :: CaveKind -> Rational
copenChance :: CaveKind -> Rational
chidden :: CaveKind -> Int
cactorCoeff :: CaveKind -> Int
cactorFreq :: CaveKind -> Freqs ItemKind
citemNum :: CaveKind -> Dice
citemFreq :: CaveKind -> Freqs ItemKind
cplaceFreq :: CaveKind -> Freqs PlaceKind
cpassable :: CaveKind -> Bool
clabyrinth :: CaveKind -> Bool
cdefTile :: CaveKind -> GroupName TileKind
cdarkCorTile :: CaveKind -> GroupName TileKind
clitCorTile :: CaveKind -> GroupName TileKind
cwallTile :: CaveKind -> GroupName TileKind
ccornerTile :: CaveKind -> GroupName TileKind
cfenceTileN :: CaveKind -> GroupName TileKind
cfenceTileE :: CaveKind -> GroupName TileKind
cfenceTileS :: CaveKind -> GroupName TileKind
cfenceTileW :: CaveKind -> GroupName TileKind
cfenceApart :: CaveKind -> Bool
cminStairDist :: CaveKind -> Int
cmaxStairsNum :: CaveKind -> Dice
cescapeFreq :: CaveKind -> Freqs PlaceKind
cstairFreq :: CaveKind -> Freqs PlaceKind
cstairAllowed :: CaveKind -> Freqs PlaceKind
cskip :: CaveKind -> [Int]
cinitSleep :: CaveKind -> InitSleep
cdesc :: CaveKind -> Text
cname :: Text
cfreq :: Freqs CaveKind
cXminSize :: Int
cYminSize :: Int
ccellSize :: DiceXY
cminPlaceSize :: DiceXY
cmaxPlaceSize :: DiceXY
cdarkOdds :: Dice
cnightOdds :: Dice
cauxConnects :: Rational
cmaxVoid :: Rational
cdoorChance :: Rational
copenChance :: Rational
chidden :: Int
cactorCoeff :: Int
cactorFreq :: Freqs ItemKind
citemNum :: Dice
citemFreq :: Freqs ItemKind
cplaceFreq :: Freqs PlaceKind
cpassable :: Bool
clabyrinth :: Bool
cdefTile :: GroupName TileKind
cdarkCorTile :: GroupName TileKind
clitCorTile :: GroupName TileKind
cwallTile :: GroupName TileKind
ccornerTile :: GroupName TileKind
cfenceTileN :: GroupName TileKind
cfenceTileE :: GroupName TileKind
cfenceTileS :: GroupName TileKind
cfenceTileW :: GroupName TileKind
cfenceApart :: Bool
cminStairDist :: Int
cmaxStairsNum :: Dice
cescapeFreq :: Freqs PlaceKind
cstairFreq :: Freqs PlaceKind
cstairAllowed :: Freqs PlaceKind
cskip :: [Int]
cinitSleep :: InitSleep
cdesc :: Text
..} =
  let (Int
minCellSizeX, Int
minCellSizeY) = DiceXY -> (Int, Int)
Dice.infDiceXY DiceXY
ccellSize
      (Int
maxCellSizeX, Int
maxCellSizeY) = DiceXY -> (Int, Int)
Dice.supDiceXY DiceXY
ccellSize
      (Int
minMinSizeX, Int
minMinSizeY) = DiceXY -> (Int, Int)
Dice.infDiceXY DiceXY
cminPlaceSize
      (Int
maxMinSizeX, Int
maxMinSizeY) = DiceXY -> (Int, Int)
Dice.supDiceXY DiceXY
cminPlaceSize
      (Int
minMaxSizeX, Int
minMaxSizeY) = DiceXY -> (Int, Int)
Dice.infDiceXY DiceXY
cmaxPlaceSize
  in [ Text
"cname longer than 25" | Text -> Int
T.length Text
cname Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
25 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"cXminSize > RK.rWidthMax" | Int
cXminSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RuleContent -> Int
RK.rWidthMax RuleContent
corule ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"cYminSize > RK.rHeightMax" | Int
cYminSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RuleContent -> Int
RK.rHeightMax RuleContent
corule ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"cXminSize < 8" | Int
cXminSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"cYminSize < 8" | Int
cYminSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 ]  -- see @focusArea@
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"cXminSize - 2 < maxCellSizeX" | Int
cXminSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxCellSizeX ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"cYminSize - 2 < maxCellSizeY" | Int
cYminSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxCellSizeY ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minCellSizeX < 2" | Int
minCellSizeX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minCellSizeY < 2" | Int
minCellSizeY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minCellSizeX < 4 and stairs"
        | Int
minCellSizeX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
&& Bool -> Bool
not (Freqs PlaceKind -> Bool
forall a. [a] -> Bool
null Freqs PlaceKind
cstairFreq) ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minCellSizeY < 4 and stairs"
        | Int
minCellSizeY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
&& Bool -> Bool
not (Freqs PlaceKind -> Bool
forall a. [a] -> Bool
null Freqs PlaceKind
cstairFreq) ]
     -- The following four are heuristics, so not too restrictive:
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minCellSizeX < 6 && non-trivial stairs"
        | Int
minCellSizeX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 Bool -> Bool -> Bool
&& Bool -> Bool
not (Freqs PlaceKind -> Int
forall a. [a] -> Int
length Freqs PlaceKind
cstairFreq Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
&& Freqs PlaceKind -> Bool
forall a. [a] -> Bool
null Freqs PlaceKind
cescapeFreq) ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minCellSizeY < 4 && non-trivial stairs"
        | Int
minCellSizeY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
&& Bool -> Bool
not (Freqs PlaceKind -> Int
forall a. [a] -> Int
length Freqs PlaceKind
cstairFreq Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
&& Freqs PlaceKind -> Bool
forall a. [a] -> Bool
null Freqs PlaceKind
cescapeFreq) ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minMinSizeX < 5 && non-trivial stairs"
        | Int
minMinSizeX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 Bool -> Bool -> Bool
&& Bool -> Bool
not (Freqs PlaceKind -> Int
forall a. [a] -> Int
length Freqs PlaceKind
cstairFreq Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
&& Freqs PlaceKind -> Bool
forall a. [a] -> Bool
null Freqs PlaceKind
cescapeFreq) ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minMinSizeY < 3 && non-trivial stairs"
        | Int
minMinSizeY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
&& Bool -> Bool
not (Freqs PlaceKind -> Int
forall a. [a] -> Int
length Freqs PlaceKind
cstairFreq Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
&& Freqs PlaceKind -> Bool
forall a. [a] -> Bool
null Freqs PlaceKind
cescapeFreq) ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minMinSizeX < 1" | Int
minMinSizeX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minMinSizeY < 1" | Int
minMinSizeY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minMaxSizeX < maxMinSizeX" | Int
minMaxSizeX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxMinSizeX ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"minMaxSizeY < maxMinSizeY" | Int
minMaxSizeY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxMinSizeY ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"chidden < 0" | Int
chidden Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"cactorCoeff < 0" | Int
cactorCoeff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"citemNum < 0" | Dice -> Int
Dice.infDice Dice
citemNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"cmaxStairsNum < 0" | Dice -> Int
Dice.infDice Dice
cmaxStairsNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"stairs suggested, but not defined"
        | Dice -> Int
Dice.supDice Dice
cmaxStairsNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Freqs PlaceKind -> Bool
forall a. [a] -> Bool
null Freqs PlaceKind
cstairFreq ]

-- | Validate all cave kinds.
-- Note that names don't have to be unique: we can have several variants
-- of a cave with a given name.
validateAll :: [CaveKind] -> ContentData CaveKind -> [Text]
validateAll :: [CaveKind] -> ContentData CaveKind -> [Text]
validateAll [CaveKind]
_ ContentData CaveKind
_ = []  -- so far, always valid

-- * Mandatory item groups

mandatoryGroups :: [GroupName CaveKind]
mandatoryGroups :: [GroupName CaveKind]
mandatoryGroups =
       [GroupName CaveKind
DEFAULT_RANDOM]

pattern DEFAULT_RANDOM :: GroupName CaveKind

pattern $mDEFAULT_RANDOM :: forall {r}. GroupName CaveKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bDEFAULT_RANDOM :: GroupName CaveKind
DEFAULT_RANDOM = GroupName "default random"

makeData :: RK.RuleContent
         -> [CaveKind] -> [GroupName CaveKind] -> [GroupName CaveKind]
         -> ContentData CaveKind
makeData :: RuleContent
-> [CaveKind]
-> [GroupName CaveKind]
-> [GroupName CaveKind]
-> ContentData CaveKind
makeData RuleContent
corule [CaveKind]
content [GroupName CaveKind]
groupNamesSingleton [GroupName CaveKind]
groupNames =
  String
-> (CaveKind -> Text)
-> (CaveKind -> Freqs CaveKind)
-> (CaveKind -> [Text])
-> ([CaveKind] -> ContentData CaveKind -> [Text])
-> [CaveKind]
-> [GroupName CaveKind]
-> [GroupName CaveKind]
-> ContentData CaveKind
forall c.
Show c =>
String
-> (c -> Text)
-> (c -> Freqs c)
-> (c -> [Text])
-> ([c] -> ContentData c -> [Text])
-> [c]
-> [GroupName c]
-> [GroupName c]
-> ContentData c
makeContentData String
"CaveKind" CaveKind -> Text
cname CaveKind -> Freqs CaveKind
cfreq (RuleContent -> CaveKind -> [Text]
validateSingle RuleContent
corule) [CaveKind] -> ContentData CaveKind -> [Text]
validateAll
                  [CaveKind]
content
                  [GroupName CaveKind]
groupNamesSingleton
                  ([GroupName CaveKind]
mandatoryGroups [GroupName CaveKind]
-> [GroupName CaveKind] -> [GroupName CaveKind]
forall a. [a] -> [a] -> [a]
++ [GroupName CaveKind]
groupNames)