module Game.LambdaHack.Content.CaveKind
( CaveKind(..), makeData
#ifdef EXPOSE_INTERNAL
, validateSingle, validateAll
#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 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
data CaveKind = CaveKind
{ csymbol :: Char
, cname :: Text
, cfreq :: Freqs CaveKind
, cXminSize :: X
, cYminSize :: Y
, ccellSize :: Dice.DiceXY
, cminPlaceSize :: Dice.DiceXY
, cmaxPlaceSize :: Dice.DiceXY
, cdarkOdds :: Dice.Dice
, cnightOdds :: Dice.Dice
, cauxConnects :: Rational
, cmaxVoid :: Rational
, cminStairDist :: Int
, cextraStairs :: Dice.Dice
, cdoorChance :: Chance
, copenChance :: Chance
, chidden :: Int
, cactorCoeff :: Int
, cactorFreq :: Freqs ItemKind
, citemNum :: Dice.Dice
, citemFreq :: Freqs ItemKind
, cplaceFreq :: Freqs PlaceKind
, cpassable :: Bool
, labyrinth :: 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
, clegendDarkTile :: GroupName TileKind
, clegendLitTile :: GroupName TileKind
, cescapeFreq :: Freqs PlaceKind
, cstairFreq :: Freqs PlaceKind
, cstairAllowed :: Freqs PlaceKind
, cdesc :: Text
}
deriving Show
validateSingle :: CaveKind -> [Text]
validateSingle CaveKind{..} =
let (minCellSizeX, minCellSizeY) = Dice.infDiceXY ccellSize
(minMinSizeX, minMinSizeY) = Dice.infDiceXY cminPlaceSize
(maxMinSizeX, maxMinSizeY) = Dice.supDiceXY cminPlaceSize
(minMaxSizeX, minMaxSizeY) = Dice.infDiceXY cmaxPlaceSize
in [ "cname longer than 25" | T.length cname > 25 ]
++ [ "cXminSize < 20" | cXminSize < 20 ]
++ [ "cYminSize < 20" | cYminSize < 20 ]
++ [ "minCellSizeX < 1" | minCellSizeX < 1 ]
++ [ "minCellSizeY < 1" | minCellSizeY < 1 ]
++ [ "minCellSizeX < 6 && stairs"
| minCellSizeX < 6 && not (null cstairFreq && null cescapeFreq) ]
++ [ "minCellSizeY < 4 && stairs"
| minCellSizeY < 4 && not (null cstairFreq && null cescapeFreq) ]
++ [ "minMinSizeX < 5 && stairs"
| minMinSizeX < 5 && not (null cstairFreq && null cescapeFreq) ]
++ [ "minMinSizeY < 3 && stairs"
| minMinSizeY < 3 && not (null cstairFreq && null cescapeFreq) ]
++ [ "minMinSizeX < 1" | minMinSizeX < 1 ]
++ [ "minMinSizeY < 1" | minMinSizeY < 1 ]
++ [ "minMaxSizeX < maxMinSizeX" | minMaxSizeX < maxMinSizeX ]
++ [ "minMaxSizeY < maxMinSizeY" | minMaxSizeY < maxMinSizeY ]
++ [ "cextraStairs < 0" | Dice.infDice cextraStairs < 0 ]
++ [ "chidden < 0" | chidden < 0 ]
++ [ "cactorCoeff < 0" | cactorCoeff < 0 ]
++ [ "citemNum < 0" | Dice.infDice citemNum < 0 ]
++ [ "stairs suggested, but not defined"
| Dice.supDice cextraStairs > 0 && null cstairFreq ]
validateAll :: ContentData ItemKind
-> ContentData PlaceKind
-> ContentData TileKind
-> [CaveKind]
-> ContentData CaveKind
-> [Text]
validateAll coitem coplace cotile content cocave =
let missingActorFreq = filter (not . omemberGroup coitem)
$ concatMap (map fst . cactorFreq) content
missingItemFreq = filter (not . omemberGroup coitem)
$ concatMap (map fst . citemFreq) content
missingPlaceFreq = filter (not . omemberGroup coplace)
$ concatMap (map fst . cplaceFreq) content
missingEscapeGroup = filter (not . omemberGroup coplace . fst)
$ concatMap cescapeFreq content
missingStairFreq = filter (not . omemberGroup coplace)
$ concatMap (map fst . cstairFreq) content
tileGroupFuns = [ cdefTile, cdarkCorTile, clitCorTile, cwallTile
, cfenceTileN, cfenceTileE, cfenceTileS, cfenceTileW
, clegendDarkTile, clegendLitTile ]
g kind = map ($ kind) tileGroupFuns
missingTileFreq = filter (not . omemberGroup cotile)
$ concatMap g content
in [ "cactorFreq item groups not in content:" <+> tshow missingActorFreq
| not $ null missingActorFreq ]
++ [ "citemFreq item groups not in content:" <+> tshow missingItemFreq
| not $ null missingItemFreq ]
++ [ "cplaceFreq place groups not in content:" <+> tshow missingPlaceFreq
| not $ null missingPlaceFreq ]
++ [ "cescapeFreq place groups not in content:"
<+> tshow missingEscapeGroup
| not $ null missingEscapeGroup ]
++ [ "cstairFreq place groups not in content:" <+> tshow missingStairFreq
| not $ null missingStairFreq ]
++ [ "tile groups not in content:" <+> tshow missingTileFreq
| not $ null missingTileFreq ]
++ [ "no cave defined for \"default random\""
| not $ omemberGroup cocave "default random" ]
makeData :: ContentData ItemKind
-> ContentData PlaceKind
-> ContentData TileKind
-> [CaveKind]
-> ContentData CaveKind
makeData coitem coplace cotile =
makeContentData "CaveKind" cname cfreq validateSingle
(validateAll coitem coplace cotile)