-- | 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
  { ModeKind -> Text
mname     :: Text            -- ^ short description
  , ModeKind -> Freqs ModeKind
mfreq     :: Freqs ModeKind  -- ^ frequency within groups
  , ModeKind -> Bool
mtutorial :: Bool            -- ^ whether to show tutorial messages, etc.
  , ModeKind -> Bool
mattract  :: Bool            -- ^ whether this is an attract mode
  , ModeKind -> Roster
mroster   :: Roster          -- ^ factions taking part in the game
  , ModeKind -> Caves
mcaves    :: Caves           -- ^ arena of the game
  , ModeKind -> [(Outcome, Text)]
mendMsg   :: [(Outcome, Text)]
      -- ^ messages displayed at each particular game ends; if message empty,
      --   the screen is skipped
  , ModeKind -> Text
mrules    :: Text            -- ^ rules note
  , ModeKind -> Text
mdesc     :: Text            -- ^ description
  , ModeKind -> Text
mreason   :: Text            -- ^ why/when the mode should be played
  , ModeKind -> Text
mhint     :: Text            -- ^ hints in case player faces difficulties
  }
  deriving Int -> ModeKind -> ShowS
[ModeKind] -> ShowS
ModeKind -> String
(Int -> ModeKind -> ShowS)
-> (ModeKind -> String) -> ([ModeKind] -> ShowS) -> Show ModeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModeKind -> ShowS
showsPrec :: Int -> ModeKind -> ShowS
$cshow :: ModeKind -> String
show :: ModeKind -> String
$cshowList :: [ModeKind] -> ShowS
showList :: [ModeKind] -> ShowS
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 :: ContentData FactionKind -> ModeKind -> [Text]
validateSingle ContentData FactionKind
cofact ModeKind{Bool
Caves
Roster
Freqs ModeKind
[(Outcome, Text)]
Text
mname :: ModeKind -> Text
mfreq :: ModeKind -> Freqs ModeKind
mtutorial :: ModeKind -> Bool
mattract :: ModeKind -> Bool
mroster :: ModeKind -> Roster
mcaves :: ModeKind -> Caves
mendMsg :: ModeKind -> [(Outcome, Text)]
mrules :: ModeKind -> Text
mdesc :: ModeKind -> Text
mreason :: ModeKind -> Text
mhint :: ModeKind -> Text
mname :: Text
mfreq :: Freqs ModeKind
mtutorial :: Bool
mattract :: Bool
mroster :: Roster
mcaves :: Caves
mendMsg :: [(Outcome, Text)]
mrules :: Text
mdesc :: Text
mreason :: Text
mhint :: Text
..} =
  [ Text
"mname longer than 22" | Text -> Int
T.length Text
mname Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
22 ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let f :: ([a], [a]) -> [Text]
f cave :: ([a], [a])
cave@([a]
ns, [a]
l) =
           [ Text
"not enough or too many levels for required cave groups:"
             Text -> Text -> Text
<+> ([a], [a]) -> Text
forall a. Show a => a -> Text
tshow ([a], [a])
cave
           | [a] -> Int
forall a. [a] -> Int
length [a]
ns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall a. [a] -> Int
length [a]
l ]
     in (([Int], [GroupName CaveKind]) -> [Text]) -> Caves -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int], [GroupName CaveKind]) -> [Text]
forall {a} {a}. (Show a, Show a) => ([a], [a]) -> [Text]
f Caves
mcaves
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ContentData FactionKind -> Caves -> Roster -> [Text]
validateSingleRoster ContentData FactionKind
cofact Caves
mcaves Roster
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 :: ContentData FactionKind -> Caves -> Roster -> [Text]
validateSingleRoster ContentData FactionKind
cofact Caves
caves Roster
roster =
  let emptyGroups :: [GroupName FactionKind]
emptyGroups = (GroupName FactionKind -> Bool)
-> [GroupName FactionKind] -> [GroupName FactionKind]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (GroupName FactionKind -> Bool) -> GroupName FactionKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentData FactionKind -> GroupName FactionKind -> Bool
forall a. ContentData a -> GroupName a -> Bool
oexistsGroup ContentData FactionKind
cofact) ([GroupName FactionKind] -> [GroupName FactionKind])
-> [GroupName FactionKind] -> [GroupName FactionKind]
forall a b. (a -> b) -> a -> b
$ ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
 -> GroupName FactionKind)
-> Roster -> [GroupName FactionKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> GroupName FactionKind
forall a b. (a, b) -> a
fst Roster
roster
  in [ Text
"the following faction kind groups have no representative with non-zero frequency:"
       Text -> Text -> Text
<+> Text -> [Text] -> Text
T.intercalate Text
", " ((GroupName FactionKind -> Text)
-> [GroupName FactionKind] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map GroupName FactionKind -> Text
forall c. GroupName c -> Text
displayGroupName [GroupName FactionKind]
emptyGroups)
     | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GroupName FactionKind] -> Bool
forall a. [a] -> Bool
null [GroupName FactionKind]
emptyGroups ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let fkKeepsAlive :: Bool -> p -> p -> FactionKind -> Bool
fkKeepsAlive Bool
acc p
_ p
_ FactionKind
fk = Bool
acc Bool -> Bool -> Bool
&& FactionKind -> Bool
fneverEmpty FactionKind
fk
           -- all of group elements have to keep level alive, hence conjunction
         fkGroupKeepsAlive :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupKeepsAlive (GroupName FactionKind
fkGroup, [(Int, Dice, GroupName ItemKind)]
_) =
           ContentData FactionKind
-> GroupName FactionKind
-> (Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool)
-> Bool
-> Bool
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData FactionKind
cofact GroupName FactionKind
fkGroup Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool
forall {p} {p}. Bool -> p -> p -> FactionKind -> Bool
fkKeepsAlive Bool
True
     in [ Text
"potentially no faction keeps the dungeon alive"
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
 -> Bool)
-> Roster -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupKeepsAlive Roster
roster ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let fkHasUIor :: Bool -> p -> p -> FactionKind -> Bool
fkHasUIor Bool
acc p
_ p
_ FactionKind
fk = Bool
acc Bool -> Bool -> Bool
|| FactionKind -> Bool
fhasUI FactionKind
fk
           -- single group element having UI already incurs the risk
           -- of duplication, hence disjunction
         fkGroupHasUIor :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupHasUIor (GroupName FactionKind
fkGroup, [(Int, Dice, GroupName ItemKind)]
_) =
           ContentData FactionKind
-> GroupName FactionKind
-> (Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool)
-> Bool
-> Bool
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData FactionKind
cofact GroupName FactionKind
fkGroup Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool
forall {p} {p}. Bool -> p -> p -> FactionKind -> Bool
fkHasUIor Bool
False
     in [ Text
"potentially more than one UI client"
        | Roster -> Int
forall a. [a] -> Int
length (((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
 -> Bool)
-> Roster -> Roster
forall a. (a -> Bool) -> [a] -> [a]
filter (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupHasUIor Roster
roster) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let fkHasUIand :: Bool -> p -> p -> FactionKind -> Bool
fkHasUIand Bool
acc p
_ p
_ FactionKind
fk = Bool
acc Bool -> Bool -> Bool
&& FactionKind -> Bool
fhasUI FactionKind
fk
           -- single group element missing UI already incurs the risk
           -- of no UI in the whole game, hence disjunction
         fkGroupHasUIand :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupHasUIand (GroupName FactionKind
fkGroup, [(Int, Dice, GroupName ItemKind)]
_) =
           ContentData FactionKind
-> GroupName FactionKind
-> (Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool)
-> Bool
-> Bool
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData FactionKind
cofact GroupName FactionKind
fkGroup Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool
forall {p} {p}. Bool -> p -> p -> FactionKind -> Bool
fkHasUIand Bool
True
     in [ Text
"potentially less than one UI client"
        | Bool -> Bool
not (((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
 -> Bool)
-> Roster -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupHasUIand Roster
roster) ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let fkTokens :: [TeamContinuity] -> p -> p -> FactionKind -> [TeamContinuity]
fkTokens [TeamContinuity]
acc p
_ p
_ FactionKind
fk = FactionKind -> TeamContinuity
fteam FactionKind
fk TeamContinuity -> [TeamContinuity] -> [TeamContinuity]
forall a. a -> [a] -> [a]
: [TeamContinuity]
acc
         fkGroupTokens :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity]
fkGroupTokens (GroupName FactionKind
fkGroup, [(Int, Dice, GroupName ItemKind)]
_) = ContentData FactionKind
-> GroupName FactionKind
-> ([TeamContinuity]
    -> Int -> ContentId FactionKind -> FactionKind -> [TeamContinuity])
-> [TeamContinuity]
-> [TeamContinuity]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData FactionKind
cofact GroupName FactionKind
fkGroup [TeamContinuity]
-> Int -> ContentId FactionKind -> FactionKind -> [TeamContinuity]
forall {p} {p}.
[TeamContinuity] -> p -> p -> FactionKind -> [TeamContinuity]
fkTokens []
         tokens :: [TeamContinuity]
tokens = ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
 -> [TeamContinuity])
-> Roster -> [TeamContinuity]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([TeamContinuity] -> [TeamContinuity]
forall a. Eq a => [a] -> [a]
nub ([TeamContinuity] -> [TeamContinuity])
-> ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
    -> [TeamContinuity])
-> (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeamContinuity] -> [TeamContinuity]
forall a. Ord a => [a] -> [a]
sort ([TeamContinuity] -> [TeamContinuity])
-> ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
    -> [TeamContinuity])
-> (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity]
fkGroupTokens) Roster
roster
         nubTokens :: [TeamContinuity]
nubTokens = [TeamContinuity] -> [TeamContinuity]
forall a. Eq a => [a] -> [a]
nub ([TeamContinuity] -> [TeamContinuity])
-> ([TeamContinuity] -> [TeamContinuity])
-> [TeamContinuity]
-> [TeamContinuity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeamContinuity] -> [TeamContinuity]
forall a. Ord a => [a] -> [a]
sort ([TeamContinuity] -> [TeamContinuity])
-> [TeamContinuity] -> [TeamContinuity]
forall a b. (a -> b) -> a -> b
$ [TeamContinuity]
tokens
     in [ Text
"potentially duplicate team continuity token"
        | [TeamContinuity] -> Int
forall a. [a] -> Int
length [TeamContinuity]
tokens Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [TeamContinuity] -> Int
forall a. [a] -> Int
length [TeamContinuity]
nubTokens ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let keys :: [Int]
keys = (([Int], [GroupName CaveKind]) -> [Int]) -> Caves -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int], [GroupName CaveKind]) -> [Int]
forall a b. (a, b) -> a
fst Caves
caves  -- permitted to be empty, for tests
         minD :: Int
minD = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
keys
         maxD :: Int
maxD = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
keys
         f :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [Text]
f (GroupName FactionKind
_, [(Int, Dice, GroupName ItemKind)]
l) = ((Int, Dice, GroupName ItemKind) -> [Text])
-> [(Int, Dice, GroupName ItemKind)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Dice, GroupName ItemKind) -> [Text]
g [(Int, Dice, GroupName ItemKind)]
l
         g :: (Int, Dice, GroupName ItemKind) -> [Text]
g i3 :: (Int, Dice, GroupName ItemKind)
i3@(Int
ln, Dice
_, GroupName ItemKind
_) =
           [ Text
"initial actor levels not among caves:" Text -> Text -> Text
<+> (Int, Dice, GroupName ItemKind) -> Text
forall a. Show a => a -> Text
tshow (Int, Dice, GroupName ItemKind)
i3
           | Int
ln Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
keys ]
     in ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
 -> [Text])
-> Roster -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [Text]
f Roster
roster
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"player is confused by both positive and negative level numbers"
           | Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
null [Int]
keys) Bool -> Bool -> Bool
&& Int -> Int
forall a. Num a => a -> a
signum Int
minD Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int
forall a. Num a => a -> a
signum Int
maxD ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"player is confused by level numer zero"
           | Int
0 Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
keys ]

-- | Validate game mode kinds together.
validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]
validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]
validateAll [ModeKind]
_ ContentData ModeKind
_ = []  -- so far, always valid

-- * Mandatory item groups

mandatoryGroups :: [GroupName ModeKind]
mandatoryGroups :: [GroupName ModeKind]
mandatoryGroups =
       [GroupName ModeKind
CAMPAIGN_SCENARIO, GroupName ModeKind
INSERT_COIN]

pattern CAMPAIGN_SCENARIO, INSERT_COIN :: GroupName ModeKind

pattern $mCAMPAIGN_SCENARIO :: forall {r}. GroupName ModeKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCAMPAIGN_SCENARIO :: GroupName ModeKind
CAMPAIGN_SCENARIO = GroupName "campaign scenario"
pattern $mINSERT_COIN :: forall {r}. GroupName ModeKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bINSERT_COIN :: GroupName ModeKind
INSERT_COIN = GroupName "insert coin"

makeData :: ContentData FactionKind
         -> [ModeKind] -> [GroupName ModeKind] -> [GroupName ModeKind]
         -> ContentData ModeKind
makeData :: ContentData FactionKind
-> [ModeKind]
-> [GroupName ModeKind]
-> [GroupName ModeKind]
-> ContentData ModeKind
makeData ContentData FactionKind
cofact [ModeKind]
content [GroupName ModeKind]
groupNamesSingleton [GroupName ModeKind]
groupNames =
  String
-> (ModeKind -> Text)
-> (ModeKind -> Freqs ModeKind)
-> (ModeKind -> [Text])
-> ([ModeKind] -> ContentData ModeKind -> [Text])
-> [ModeKind]
-> [GroupName ModeKind]
-> [GroupName ModeKind]
-> ContentData ModeKind
forall c.
Show c =>
String
-> (c -> Text)
-> (c -> Freqs c)
-> (c -> [Text])
-> ([c] -> ContentData c -> [Text])
-> [c]
-> [GroupName c]
-> [GroupName c]
-> ContentData c
makeContentData String
"ModeKind" ModeKind -> Text
mname ModeKind -> Freqs ModeKind
mfreq (ContentData FactionKind -> ModeKind -> [Text]
validateSingle ContentData FactionKind
cofact) [ModeKind] -> ContentData ModeKind -> [Text]
validateAll
                  [ModeKind]
content
                  [GroupName ModeKind]
groupNamesSingleton
                  ([GroupName ModeKind]
mandatoryGroups [GroupName ModeKind]
-> [GroupName ModeKind] -> [GroupName ModeKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ModeKind]
groupNames)