1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
-- | The type of game modes.
module Game.LambdaHack.Content.ModeKind
( pattern CAMPAIGN_SCENARIO, pattern INSERT_COIN
, ModeKind(..), makeData
, Caves, Roster
, mandatoryGroups
#ifdef EXPOSE_INTERNAL
-- * Internal operations
, validateSingle, validateAll, validateSingleRoster
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.Text as T
import Game.LambdaHack.Content.CaveKind (CaveKind)
import Game.LambdaHack.Content.FactionKind
(FactionKind (..), Outcome (..))
import Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Definition.ContentData
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.DefsInternal
-- | Game mode specification.
data ModeKind = ModeKind
{ mname :: Text -- ^ short description
, mfreq :: Freqs ModeKind -- ^ frequency within groups
, mtutorial :: Bool -- ^ whether to show tutorial messages, etc.
, mattract :: Bool -- ^ whether this is an attract mode
, mroster :: Roster -- ^ factions taking part in the game
, mcaves :: Caves -- ^ arena of the game
, mendMsg :: [(Outcome, Text)]
-- ^ messages displayed at each particular game ends; if message empty,
-- the screen is skipped
, mrules :: Text -- ^ rules note
, mdesc :: Text -- ^ description
, mreason :: Text -- ^ why/when the mode should be played
, mhint :: Text -- ^ hints in case player faces difficulties
}
deriving Show
-- | Requested cave groups for particular level intervals.
type Caves = [([Int], [GroupName CaveKind])]
-- | The specification of factions and of levels, numbers and groups
-- of their initial members.
type Roster = [( GroupName FactionKind
, [(Int, Dice.Dice, GroupName ItemKind)] )]
-- | Catch invalid game mode kind definitions.
validateSingle :: ContentData FactionKind -> ModeKind -> [Text]
validateSingle cofact ModeKind{..} =
[ "mname longer than 22" | T.length mname > 22 ]
++ 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 cofact mcaves mroster
-- | Checks, in particular, that there is at least one faction with fneverEmpty
-- or the game would get stuck as soon as the dungeon is devoid of actors.
validateSingleRoster :: ContentData FactionKind -> Caves -> Roster -> [Text]
validateSingleRoster cofact caves roster =
let emptyGroups = filter (not . oexistsGroup cofact) $ map fst roster
in [ "the following faction kind groups have no representative with non-zero frequency:"
<+> T.intercalate ", " (map displayGroupName emptyGroups)
| not $ null emptyGroups ]
++ let fkKeepsAlive acc _ _ fk = acc && fneverEmpty fk
-- all of group elements have to keep level alive, hence conjunction
fkGroupKeepsAlive (fkGroup, _) =
ofoldlGroup' cofact fkGroup fkKeepsAlive True
in [ "potentially no faction keeps the dungeon alive"
| not $ any fkGroupKeepsAlive roster ]
++ let fkHasUIor acc _ _ fk = acc || fhasUI fk
-- single group element having UI already incurs the risk
-- of duplication, hence disjunction
fkGroupHasUIor (fkGroup, _) =
ofoldlGroup' cofact fkGroup fkHasUIor False
in [ "potentially more than one UI client"
| length (filter fkGroupHasUIor roster) > 1 ]
++ let fkHasUIand acc _ _ fk = acc && fhasUI fk
-- single group element missing UI already incurs the risk
-- of no UI in the whole game, hence disjunction
fkGroupHasUIand (fkGroup, _) =
ofoldlGroup' cofact fkGroup fkHasUIand True
in [ "potentially less than one UI client"
| not (any fkGroupHasUIand roster) ]
++ let fkTokens acc _ _ fk = fteam fk : acc
fkGroupTokens (fkGroup, _) = ofoldlGroup' cofact fkGroup fkTokens []
tokens = concatMap (nub . sort . fkGroupTokens) roster
nubTokens = nub . sort $ tokens
in [ "potentially duplicate team continuity token"
| length tokens /= length nubTokens ]
++ let keys = concatMap fst caves -- permitted to be empty, for tests
minD = minimum keys
maxD = maximum keys
f (_, l) = concatMap g l
g i3@(ln, _, _) =
[ "initial actor levels not among caves:" <+> tshow i3
| ln `notElem` keys ]
in concatMap f roster
++ [ "player is confused by both positive and negative level numbers"
| not (null keys) && signum minD /= signum maxD ]
++ [ "player is confused by level numer zero"
| 0 `elem` keys ]
-- | Validate game mode kinds together.
validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]
validateAll _ _ = [] -- so far, always valid
-- * Mandatory item groups
mandatoryGroups :: [GroupName ModeKind]
mandatoryGroups =
[CAMPAIGN_SCENARIO, INSERT_COIN]
pattern CAMPAIGN_SCENARIO, INSERT_COIN :: GroupName ModeKind
pattern CAMPAIGN_SCENARIO = GroupName "campaign scenario"
pattern INSERT_COIN = GroupName "insert coin"
makeData :: ContentData FactionKind
-> [ModeKind] -> [GroupName ModeKind] -> [GroupName ModeKind]
-> ContentData ModeKind
makeData cofact content groupNamesSingleton groupNames =
makeContentData "ModeKind" mname mfreq (validateSingle cofact) validateAll
content
groupNamesSingleton
(mandatoryGroups ++ groupNames)
|
