{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Content.ModeKind
( Caves, Roster(..), Player(..), ModeKind(..), LeaderMode(..), AutoLeader(..)
, Outcome(..), HiIndeterminant(..), HiCondPoly, HiSummand, HiPolynomial
, validateSingleModeKind, validateAllModeKind
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.IntMap.Strict as IM
import qualified Data.Set as S
import qualified Data.Text as T
import GHC.Generics (Generic)
import Game.LambdaHack.Common.Ability
import qualified Game.LambdaHack.Common.Dice as Dice
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Content.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
type Caves = IM.IntMap (GroupName CaveKind)
data Roster = Roster
{ rosterList :: [(Player, [(Int, Dice.Dice, GroupName ItemKind)])]
, rosterEnemy :: [(Text, Text)]
, rosterAlly :: [(Text, Text)]
}
deriving (Show, Eq)
data Outcome =
Killed
| Defeated
| Camping
| Conquer
| Escape
| Restart
deriving (Show, Eq, Ord, Enum, Bounded, Generic)
instance Binary Outcome
data HiIndeterminant = HiConst | HiLoot | HiBlitz | HiSurvival | HiKill | HiLoss
deriving (Show, Eq, Ord, Generic)
instance Binary HiIndeterminant
type HiPolynomial = [(HiIndeterminant, Double)]
type HiSummand = (HiPolynomial, [Outcome])
type HiCondPoly = [HiSummand]
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, Ord, Generic)
instance Binary Player
data LeaderMode =
LeaderNull
| LeaderAI AutoLeader
| LeaderUI AutoLeader
deriving (Show, Eq, Ord, Generic)
instance Binary LeaderMode
data AutoLeader = AutoLeader
{ autoDungeon :: Bool
, autoLevel :: Bool
}
deriving (Show, Eq, Ord, Generic)
instance Binary AutoLeader
validateSingleModeKind :: ModeKind -> [Text]
validateSingleModeKind 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 ]
validateAllModeKind :: [ModeKind] -> [Text]
validateAllModeKind content =
let kindFreq :: S.Set (GroupName ModeKind)
kindFreq = let tuples = [ cgroup
| k <- content
, (cgroup, n) <- mfreq k
, n > 0 ]
in S.fromList tuples
hardwiredAbsent = filter (`S.notMember` kindFreq) hardwiredModeGroups
in [ "Hardwired groups not in content:" <+> tshow hardwiredAbsent
| not $ null hardwiredAbsent ]
hardwiredModeGroups :: [GroupName ModeKind]
hardwiredModeGroups = [ "campaign scenario", "starting", "starting JS" ]