{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Content.ModeKind
( ModeKind(..), makeData
, Caves, Roster(..), Outcome(..)
, HiCondPoly, HiSummand, HiPolynomial, HiIndeterminant(..)
, Player(..), LeaderMode(..), AutoLeader(..)
, nameOfHorrorFact
#ifdef EXPOSE_INTERNAL
, validateSingle, validateAll
, validateSingleRoster, validateSinglePlayer, hardwiredModeGroups
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import Control.DeepSeq
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.IntMap.Strict as IM
import qualified Data.Text as T
import GHC.Generics (Generic)
import Game.LambdaHack.Common.Ability
import Game.LambdaHack.Common.ContentData
import qualified Game.LambdaHack.Common.Dice as Dice
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Content.CaveKind (CaveKind)
import Game.LambdaHack.Content.ItemKind (ItemKind)
data ModeKind = ModeKind
{ msymbol :: Char
, mname :: Text
, mfreq :: Freqs ModeKind
, mroster :: Roster
, mcaves :: Caves
, mdesc :: Text
}
deriving (Show, Generic)
instance NFData ModeKind
type Caves = IM.IntMap (GroupName CaveKind)
data Roster = Roster
{ rosterList :: [(Player, [(Int, Dice.Dice, GroupName ItemKind)])]
, rosterEnemy :: [(Text, Text)]
, rosterAlly :: [(Text, Text)]
}
deriving (Show, Generic)
instance NFData Roster
data Outcome =
Killed
| Defeated
| Camping
| Conquer
| Escape
| Restart
deriving (Show, Eq, Ord, Enum, Bounded, Generic)
instance Binary Outcome
instance NFData Outcome
type HiCondPoly = [HiSummand]
type HiSummand = (HiPolynomial, [Outcome])
type HiPolynomial = [(HiIndeterminant, Double)]
data HiIndeterminant = HiConst | HiLoot | HiBlitz | HiSurvival | HiKill | HiLoss
deriving (Show, Eq, Ord, Generic)
instance Binary HiIndeterminant
instance NFData HiIndeterminant
data Player = Player
{ fname :: Text
, fgroups :: [GroupName ItemKind]
, fskillsOther :: Skills
, fcanEscape :: Bool
, fneverEmpty :: Bool
, fhiCondPoly :: HiCondPoly
, fhasGender :: Bool
, ftactic :: Tactic
, fleaderMode :: LeaderMode
, fhasUI :: Bool
}
deriving (Show, Eq, Generic)
instance Binary Player
instance NFData Player
data LeaderMode =
LeaderNull
| LeaderAI AutoLeader
| LeaderUI AutoLeader
deriving (Show, Eq, Ord, Generic)
instance Binary LeaderMode
instance NFData LeaderMode
data AutoLeader = AutoLeader
{ autoDungeon :: Bool
, autoLevel :: Bool
}
deriving (Show, Eq, Ord, Generic)
instance Binary AutoLeader
instance NFData AutoLeader
nameOfHorrorFact :: GroupName ItemKind
nameOfHorrorFact = toGroupName "horror"
validateSingle :: ModeKind -> [Text]
validateSingle ModeKind{..} =
[ "mname longer than 20" | T.length mname > 20 ]
++ validateSingleRoster mcaves mroster
validateSingleRoster :: Caves -> Roster -> [Text]
validateSingleRoster caves Roster{..} =
[ "no player keeps the dungeon alive"
| all (not . fneverEmpty . fst) rosterList ]
++ concatMap (validateSinglePlayer . fst) rosterList
++ let checkPl field pl =
[ pl <+> "is not a player name in" <+> field
| all ((/= pl) . fname . fst) rosterList ]
checkDipl field (pl1, pl2) =
[ "self-diplomacy in" <+> field | pl1 == pl2 ]
++ checkPl field pl1
++ checkPl field pl2
in concatMap (checkDipl "rosterEnemy") rosterEnemy
++ concatMap (checkDipl "rosterAlly") rosterAlly
++ let f (_, l) = concatMap g l
g i3@(ln, _, _) =
if ln `elem` IM.keys caves
then []
else ["initial actor levels not among caves:" <+> tshow i3]
in concatMap f rosterList
validateSinglePlayer :: Player -> [Text]
validateSinglePlayer Player{..} =
[ "fname empty:" <+> fname | T.null fname ]
++ [ "no UI client, but UI leader:" <+> fname
| not fhasUI && case fleaderMode of
LeaderUI _ -> True
_ -> False ]
++ [ "fskillsOther not negative:" <+> fname
| any (>= 0) $ EM.elems fskillsOther ]
validateAll :: ContentData CaveKind
-> ContentData ItemKind
-> [ModeKind]
-> ContentData ModeKind
-> [Text]
validateAll cocave coitem content comode =
let missingCave = filter (not . omemberGroup cocave)
$ concatMap (IM.elems . mcaves) content
f Roster{rosterList} =
concatMap (\(p, l) -> delete nameOfHorrorFact (fgroups p)
++ map (\(_, _, grp) -> grp) l)
rosterList
missingRosterItems = filter (not . omemberGroup coitem)
$ concatMap (f . mroster) content
hardwiredAbsent = filter (not . omemberGroup comode) hardwiredModeGroups
in [ "cave groups not in content:" <+> tshow missingCave
| not $ null missingCave ]
++ [ "roster item groups not in content:" <+> tshow missingRosterItems
| not $ null missingRosterItems ]
++ [ "Hardwired groups not in content:" <+> tshow hardwiredAbsent
| not $ null hardwiredAbsent ]
hardwiredModeGroups :: [GroupName ModeKind]
hardwiredModeGroups = [ "campaign scenario", "starting", "starting JS" ]
makeData :: ContentData CaveKind
-> ContentData ItemKind
-> [ModeKind]
-> ContentData ModeKind
makeData cocave coitem =
makeContentData "ModeKind" mname mfreq validateSingle
(validateAll cocave coitem)