{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Content.ModeKind
( ModeKind(..), makeData
, Caves, Roster(..), Outcome(..)
, HiCondPoly, HiSummand, HiPolynomial, HiIndeterminant(..)
, Player(..), LeaderMode(..), AutoLeader(..)
, horrorGroup, genericEndMessages
#ifdef EXPOSE_INTERNAL
, validateSingle, validateAll
, validateSingleRoster, validateSinglePlayer, hardwiredModeGroups
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Binary
import qualified Data.Text as T
import GHC.Generics (Generic)
import Game.LambdaHack.Content.CaveKind (CaveKind)
import Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Core.Dice as Dice
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.ContentData
import Game.LambdaHack.Definition.Defs
data ModeKind = ModeKind
{ msymbol :: Char
, mname :: Text
, mfreq :: Freqs ModeKind
, mroster :: Roster
, mcaves :: Caves
, mendMsg :: [(Outcome, Text)]
, mdesc :: Text
}
deriving Show
type Caves = [([Int], [GroupName CaveKind])]
data Roster = Roster
{ rosterList :: [(Player, [(Int, Dice.Dice, GroupName ItemKind)])]
, rosterEnemy :: [(Text, Text)]
, rosterAlly :: [(Text, Text)]
}
deriving Show
data Outcome =
Killed
| Defeated
| Camping
| Conquer
| Escape
| Restart
deriving (Show, Eq, Ord, Enum, Bounded, Generic)
instance Binary Outcome
type HiCondPoly = [HiSummand]
type HiSummand = (HiPolynomial, [Outcome])
type HiPolynomial = [(HiIndeterminant, Double)]
data HiIndeterminant =
HiConst
| HiLoot
| HiSprint
| HiBlitz
| HiSurvival
| HiKill
| HiLoss
deriving (Show, Eq, Ord, Generic)
instance Binary HiIndeterminant
data Player = Player
{ fname :: Text
, fgroups :: [GroupName ItemKind]
, fskillsOther :: Ability.Skills
, fcanEscape :: Bool
, fneverEmpty :: Bool
, fhiCondPoly :: HiCondPoly
, fhasGender :: Bool
, ftactic :: Ability.Tactic
, fleaderMode :: LeaderMode
, fhasUI :: Bool
}
deriving (Show, Eq, 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
horrorGroup :: GroupName ItemKind
horrorGroup = "horror"
genericEndMessages :: [(Outcome, Text)]
genericEndMessages =
[ (Killed, "Let's hope a rescue party arrives in time!" )
, (Defeated, "Let's hope your new overlords let you live." )
, (Camping, "See you soon, stronger and braver!" )
, (Conquer, "Can it be done in a better style, though?" )
, (Escape, "Can it be done more efficiently, though?" )
, (Restart, "This time for real." ) ]
validateSingle :: ModeKind -> [Text]
validateSingle ModeKind{..} =
[ "mname longer than 20" | T.length mname > 20 ]
++ let f cave@(ns, l) =
[ "not enough or too many levels for required cave groups:"
<+> tshow cave
| length ns /= length l ]
in concatMap f mcaves
++ validateSingleRoster mcaves mroster
validateSingleRoster :: Caves -> Roster -> [Text]
validateSingleRoster caves Roster{..} =
[ "no player keeps the dungeon alive"
| all (not . fneverEmpty . fst) rosterList ]
++ [ "not exactly one UI client"
| length (filter (fhasUI . fst) rosterList) /= 1 ]
++ 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 keys = concatMap fst caves
f (_, l) = concatMap g l
g i3@(ln, _, _) =
[ "initial actor levels not among caves:" <+> tshow i3
| ln `notElem` keys ]
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) . snd) $ Ability.skillsToList fskillsOther ]
validateAll :: ContentData CaveKind
-> ContentData ItemKind
-> [ModeKind]
-> ContentData ModeKind
-> [Text]
validateAll cocave coitem content comode =
let caveGroups = concatMap snd . mcaves
missingCave = filter (not . omemberGroup cocave)
$ concatMap caveGroups content
f Roster{rosterList} =
concatMap (\(p, l) -> delete horrorGroup (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", "insert coin"]
makeData :: ContentData CaveKind
-> ContentData ItemKind
-> [ModeKind]
-> ContentData ModeKind
makeData cocave coitem =
makeContentData "ModeKind" mname mfreq validateSingle
(validateAll cocave coitem)