{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | The type of kinds of game modes.
module Game.LambdaHack.Content.ModeKind
  ( pattern CAMPAIGN_SCENARIO, pattern INSERT_COIN, pattern NO_CONFIRMS
  , ModeKind(..), makeData
  , Caves, Roster(..), TeamContinuity(..), Outcome(..)
  , HiCondPoly, HiSummand, HiPolynomial, HiIndeterminant(..)
  , Player(..), AutoLeader(..)
  , teamExplorer, victoryOutcomes, deafeatOutcomes, nameOutcomePast
  , nameOutcomeVerb, endMessageOutcome, screensave
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateSingle, validateAll
  , validateSingleRoster, validateSinglePlayer, mandatoryGroups
#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
import           Game.LambdaHack.Definition.DefsInternal

-- | Game mode specification.
data ModeKind = ModeKind
  { ModeKind -> Char
msymbol   :: Char            -- ^ a symbol
  , 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 -> Roster
mroster   :: Roster          -- ^ players 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
showList :: [ModeKind] -> ShowS
$cshowList :: [ModeKind] -> ShowS
show :: ModeKind -> String
$cshow :: ModeKind -> String
showsPrec :: Int -> ModeKind -> ShowS
$cshowsPrec :: Int -> ModeKind -> ShowS
Show

-- | Requested cave groups for particular level intervals.
type Caves = [([Int], [GroupName CaveKind])]

-- | The specification of players for the game mode.
data Roster = Roster
  { Roster
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
rosterList  :: [( Player
                    , Maybe TeamContinuity
                    , [(Int, Dice.Dice, GroupName ItemKind)] )]
      -- ^ players in the particular team and levels, numbers and groups
      --   of their initial members
  , Roster -> [(Text, Text)]
rosterEnemy :: [(Text, Text)]  -- ^ the initial enmity matrix
  , Roster -> [(Text, Text)]
rosterAlly  :: [(Text, Text)]  -- ^ the initial aliance matrix
  }
  deriving Int -> Roster -> ShowS
[Roster] -> ShowS
Roster -> String
(Int -> Roster -> ShowS)
-> (Roster -> String) -> ([Roster] -> ShowS) -> Show Roster
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Roster] -> ShowS
$cshowList :: [Roster] -> ShowS
show :: Roster -> String
$cshow :: Roster -> String
showsPrec :: Int -> Roster -> ShowS
$cshowsPrec :: Int -> Roster -> ShowS
Show

-- | Team continuity index. Starting with 1, lower than 100.
newtype TeamContinuity = TeamContinuity Int
  deriving (Int -> TeamContinuity -> ShowS
[TeamContinuity] -> ShowS
TeamContinuity -> String
(Int -> TeamContinuity -> ShowS)
-> (TeamContinuity -> String)
-> ([TeamContinuity] -> ShowS)
-> Show TeamContinuity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamContinuity] -> ShowS
$cshowList :: [TeamContinuity] -> ShowS
show :: TeamContinuity -> String
$cshow :: TeamContinuity -> String
showsPrec :: Int -> TeamContinuity -> ShowS
$cshowsPrec :: Int -> TeamContinuity -> ShowS
Show, TeamContinuity -> TeamContinuity -> Bool
(TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> Bool) -> Eq TeamContinuity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamContinuity -> TeamContinuity -> Bool
$c/= :: TeamContinuity -> TeamContinuity -> Bool
== :: TeamContinuity -> TeamContinuity -> Bool
$c== :: TeamContinuity -> TeamContinuity -> Bool
Eq, Eq TeamContinuity
Eq TeamContinuity
-> (TeamContinuity -> TeamContinuity -> Ordering)
-> (TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> TeamContinuity)
-> (TeamContinuity -> TeamContinuity -> TeamContinuity)
-> Ord TeamContinuity
TeamContinuity -> TeamContinuity -> Bool
TeamContinuity -> TeamContinuity -> Ordering
TeamContinuity -> TeamContinuity -> TeamContinuity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TeamContinuity -> TeamContinuity -> TeamContinuity
$cmin :: TeamContinuity -> TeamContinuity -> TeamContinuity
max :: TeamContinuity -> TeamContinuity -> TeamContinuity
$cmax :: TeamContinuity -> TeamContinuity -> TeamContinuity
>= :: TeamContinuity -> TeamContinuity -> Bool
$c>= :: TeamContinuity -> TeamContinuity -> Bool
> :: TeamContinuity -> TeamContinuity -> Bool
$c> :: TeamContinuity -> TeamContinuity -> Bool
<= :: TeamContinuity -> TeamContinuity -> Bool
$c<= :: TeamContinuity -> TeamContinuity -> Bool
< :: TeamContinuity -> TeamContinuity -> Bool
$c< :: TeamContinuity -> TeamContinuity -> Bool
compare :: TeamContinuity -> TeamContinuity -> Ordering
$ccompare :: TeamContinuity -> TeamContinuity -> Ordering
$cp1Ord :: Eq TeamContinuity
Ord, Int -> TeamContinuity
TeamContinuity -> Int
TeamContinuity -> [TeamContinuity]
TeamContinuity -> TeamContinuity
TeamContinuity -> TeamContinuity -> [TeamContinuity]
TeamContinuity
-> TeamContinuity -> TeamContinuity -> [TeamContinuity]
(TeamContinuity -> TeamContinuity)
-> (TeamContinuity -> TeamContinuity)
-> (Int -> TeamContinuity)
-> (TeamContinuity -> Int)
-> (TeamContinuity -> [TeamContinuity])
-> (TeamContinuity -> TeamContinuity -> [TeamContinuity])
-> (TeamContinuity -> TeamContinuity -> [TeamContinuity])
-> (TeamContinuity
    -> TeamContinuity -> TeamContinuity -> [TeamContinuity])
-> Enum TeamContinuity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TeamContinuity
-> TeamContinuity -> TeamContinuity -> [TeamContinuity]
$cenumFromThenTo :: TeamContinuity
-> TeamContinuity -> TeamContinuity -> [TeamContinuity]
enumFromTo :: TeamContinuity -> TeamContinuity -> [TeamContinuity]
$cenumFromTo :: TeamContinuity -> TeamContinuity -> [TeamContinuity]
enumFromThen :: TeamContinuity -> TeamContinuity -> [TeamContinuity]
$cenumFromThen :: TeamContinuity -> TeamContinuity -> [TeamContinuity]
enumFrom :: TeamContinuity -> [TeamContinuity]
$cenumFrom :: TeamContinuity -> [TeamContinuity]
fromEnum :: TeamContinuity -> Int
$cfromEnum :: TeamContinuity -> Int
toEnum :: Int -> TeamContinuity
$ctoEnum :: Int -> TeamContinuity
pred :: TeamContinuity -> TeamContinuity
$cpred :: TeamContinuity -> TeamContinuity
succ :: TeamContinuity -> TeamContinuity
$csucc :: TeamContinuity -> TeamContinuity
Enum, (forall x. TeamContinuity -> Rep TeamContinuity x)
-> (forall x. Rep TeamContinuity x -> TeamContinuity)
-> Generic TeamContinuity
forall x. Rep TeamContinuity x -> TeamContinuity
forall x. TeamContinuity -> Rep TeamContinuity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TeamContinuity x -> TeamContinuity
$cfrom :: forall x. TeamContinuity -> Rep TeamContinuity x
Generic)

instance Binary TeamContinuity

-- | Outcome of a game.
data Outcome =
    Escape    -- ^ the player escaped the dungeon alive
  | Conquer   -- ^ the player won by eliminating all rivals
  | Defeated  -- ^ the faction lost the game in another way
  | Killed    -- ^ the faction was eliminated
  | Restart   -- ^ game is restarted; the quitter quit
  | Camping   -- ^ game is supended
  deriving (Int -> Outcome -> ShowS
[Outcome] -> ShowS
Outcome -> String
(Int -> Outcome -> ShowS)
-> (Outcome -> String) -> ([Outcome] -> ShowS) -> Show Outcome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Outcome] -> ShowS
$cshowList :: [Outcome] -> ShowS
show :: Outcome -> String
$cshow :: Outcome -> String
showsPrec :: Int -> Outcome -> ShowS
$cshowsPrec :: Int -> Outcome -> ShowS
Show, Outcome -> Outcome -> Bool
(Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool) -> Eq Outcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Outcome -> Outcome -> Bool
$c/= :: Outcome -> Outcome -> Bool
== :: Outcome -> Outcome -> Bool
$c== :: Outcome -> Outcome -> Bool
Eq, Eq Outcome
Eq Outcome
-> (Outcome -> Outcome -> Ordering)
-> (Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Outcome)
-> (Outcome -> Outcome -> Outcome)
-> Ord Outcome
Outcome -> Outcome -> Bool
Outcome -> Outcome -> Ordering
Outcome -> Outcome -> Outcome
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Outcome -> Outcome -> Outcome
$cmin :: Outcome -> Outcome -> Outcome
max :: Outcome -> Outcome -> Outcome
$cmax :: Outcome -> Outcome -> Outcome
>= :: Outcome -> Outcome -> Bool
$c>= :: Outcome -> Outcome -> Bool
> :: Outcome -> Outcome -> Bool
$c> :: Outcome -> Outcome -> Bool
<= :: Outcome -> Outcome -> Bool
$c<= :: Outcome -> Outcome -> Bool
< :: Outcome -> Outcome -> Bool
$c< :: Outcome -> Outcome -> Bool
compare :: Outcome -> Outcome -> Ordering
$ccompare :: Outcome -> Outcome -> Ordering
$cp1Ord :: Eq Outcome
Ord, Int -> Outcome
Outcome -> Int
Outcome -> [Outcome]
Outcome -> Outcome
Outcome -> Outcome -> [Outcome]
Outcome -> Outcome -> Outcome -> [Outcome]
(Outcome -> Outcome)
-> (Outcome -> Outcome)
-> (Int -> Outcome)
-> (Outcome -> Int)
-> (Outcome -> [Outcome])
-> (Outcome -> Outcome -> [Outcome])
-> (Outcome -> Outcome -> [Outcome])
-> (Outcome -> Outcome -> Outcome -> [Outcome])
-> Enum Outcome
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Outcome -> Outcome -> Outcome -> [Outcome]
$cenumFromThenTo :: Outcome -> Outcome -> Outcome -> [Outcome]
enumFromTo :: Outcome -> Outcome -> [Outcome]
$cenumFromTo :: Outcome -> Outcome -> [Outcome]
enumFromThen :: Outcome -> Outcome -> [Outcome]
$cenumFromThen :: Outcome -> Outcome -> [Outcome]
enumFrom :: Outcome -> [Outcome]
$cenumFrom :: Outcome -> [Outcome]
fromEnum :: Outcome -> Int
$cfromEnum :: Outcome -> Int
toEnum :: Int -> Outcome
$ctoEnum :: Int -> Outcome
pred :: Outcome -> Outcome
$cpred :: Outcome -> Outcome
succ :: Outcome -> Outcome
$csucc :: Outcome -> Outcome
Enum, Outcome
Outcome -> Outcome -> Bounded Outcome
forall a. a -> a -> Bounded a
maxBound :: Outcome
$cmaxBound :: Outcome
minBound :: Outcome
$cminBound :: Outcome
Bounded, (forall x. Outcome -> Rep Outcome x)
-> (forall x. Rep Outcome x -> Outcome) -> Generic Outcome
forall x. Rep Outcome x -> Outcome
forall x. Outcome -> Rep Outcome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Outcome x -> Outcome
$cfrom :: forall x. Outcome -> Rep Outcome x
Generic)

instance Binary Outcome

-- | Conditional polynomial representing score calculation for this player.
type HiCondPoly = [HiSummand]

type HiSummand = (HiPolynomial, [Outcome])

type HiPolynomial = [(HiIndeterminant, Double)]

data HiIndeterminant =
    HiConst
  | HiLoot
  | HiSprint
  | HiBlitz
  | HiSurvival
  | HiKill
  | HiLoss
  deriving (Int -> HiIndeterminant -> ShowS
[HiIndeterminant] -> ShowS
HiIndeterminant -> String
(Int -> HiIndeterminant -> ShowS)
-> (HiIndeterminant -> String)
-> ([HiIndeterminant] -> ShowS)
-> Show HiIndeterminant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HiIndeterminant] -> ShowS
$cshowList :: [HiIndeterminant] -> ShowS
show :: HiIndeterminant -> String
$cshow :: HiIndeterminant -> String
showsPrec :: Int -> HiIndeterminant -> ShowS
$cshowsPrec :: Int -> HiIndeterminant -> ShowS
Show, HiIndeterminant -> HiIndeterminant -> Bool
(HiIndeterminant -> HiIndeterminant -> Bool)
-> (HiIndeterminant -> HiIndeterminant -> Bool)
-> Eq HiIndeterminant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HiIndeterminant -> HiIndeterminant -> Bool
$c/= :: HiIndeterminant -> HiIndeterminant -> Bool
== :: HiIndeterminant -> HiIndeterminant -> Bool
$c== :: HiIndeterminant -> HiIndeterminant -> Bool
Eq, (forall x. HiIndeterminant -> Rep HiIndeterminant x)
-> (forall x. Rep HiIndeterminant x -> HiIndeterminant)
-> Generic HiIndeterminant
forall x. Rep HiIndeterminant x -> HiIndeterminant
forall x. HiIndeterminant -> Rep HiIndeterminant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HiIndeterminant x -> HiIndeterminant
$cfrom :: forall x. HiIndeterminant -> Rep HiIndeterminant x
Generic)

instance Binary HiIndeterminant

-- | Properties of a particular player.
data Player = Player
  { Player -> Text
fname        :: Text        -- ^ name of the player
  , Player -> [GroupName ItemKind]
fgroups      :: [GroupName ItemKind]
                                -- ^ names of actor groups that may naturally
                                --   fall under player's control, e.g., upon
                                --   spawning or summoning
  , Player -> Skills
fskillsOther :: Ability.Skills
                                -- ^ fixed skill modifiers to the non-leader
                                --   actors; also summed with skills implied
                                --   by @fdoctrine@ (which is not fixed)
  , Player -> Bool
fcanEscape   :: Bool        -- ^ the player can escape the dungeon
  , Player -> Bool
fneverEmpty  :: Bool        -- ^ the faction declared killed if no actors
  , Player -> HiCondPoly
fhiCondPoly  :: HiCondPoly  -- ^ score polynomial for the player
  , Player -> Bool
fhasGender   :: Bool        -- ^ whether actors have gender
  , Player -> Doctrine
fdoctrine    :: Ability.Doctrine
                                -- ^ non-leaders behave according to this
                                --   doctrine; can be changed during the game
  , Player -> Maybe AutoLeader
fleaderMode  :: Maybe AutoLeader
                                -- ^ whether the faction can have a leader
                                --   and what's its switching mode;
  , Player -> Bool
fhasUI       :: Bool        -- ^ does the faction have a UI client
                                --   (for control or passive observation)
  , Player -> Bool
funderAI     :: Bool        -- ^ is the faction under AI control
  }
  deriving (Int -> Player -> ShowS
[Player] -> ShowS
Player -> String
(Int -> Player -> ShowS)
-> (Player -> String) -> ([Player] -> ShowS) -> Show Player
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Player] -> ShowS
$cshowList :: [Player] -> ShowS
show :: Player -> String
$cshow :: Player -> String
showsPrec :: Int -> Player -> ShowS
$cshowsPrec :: Int -> Player -> ShowS
Show, Player -> Player -> Bool
(Player -> Player -> Bool)
-> (Player -> Player -> Bool) -> Eq Player
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Player -> Player -> Bool
$c/= :: Player -> Player -> Bool
== :: Player -> Player -> Bool
$c== :: Player -> Player -> Bool
Eq, (forall x. Player -> Rep Player x)
-> (forall x. Rep Player x -> Player) -> Generic Player
forall x. Rep Player x -> Player
forall x. Player -> Rep Player x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Player x -> Player
$cfrom :: forall x. Player -> Rep Player x
Generic)

instance Binary Player

data AutoLeader = AutoLeader
  { AutoLeader -> Bool
autoDungeon :: Bool
      -- ^ leader switching between levels is automatically done by the server
      --   and client is not permitted to change to leaders from other levels
      --   (the frequency of leader level switching done by the server
      --   is controlled by @RuleKind.rleadLevelClips@);
      --   if the flag is @False@, server still does a subset
      --   of the automatic switching, e.g., when the old leader dies
      --   and no other actor of the faction resides on his level,
      --   but the client (particularly UI) is expected to do changes as well
  , AutoLeader -> Bool
autoLevel   :: Bool
      -- ^ client is discouraged from leader switching (e.g., because
      --   non-leader actors have the same skills as leader);
      --   server is guaranteed to switch leader within a level very rarely,
      --   e.g., when the old leader dies;
      --   if the flag is @False@, server still does a subset
      --   of the automatic switching, but the client is expected to do more,
      --   because it's advantageous for that kind of a faction
  }
  deriving (Int -> AutoLeader -> ShowS
[AutoLeader] -> ShowS
AutoLeader -> String
(Int -> AutoLeader -> ShowS)
-> (AutoLeader -> String)
-> ([AutoLeader] -> ShowS)
-> Show AutoLeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoLeader] -> ShowS
$cshowList :: [AutoLeader] -> ShowS
show :: AutoLeader -> String
$cshow :: AutoLeader -> String
showsPrec :: Int -> AutoLeader -> ShowS
$cshowsPrec :: Int -> AutoLeader -> ShowS
Show, AutoLeader -> AutoLeader -> Bool
(AutoLeader -> AutoLeader -> Bool)
-> (AutoLeader -> AutoLeader -> Bool) -> Eq AutoLeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutoLeader -> AutoLeader -> Bool
$c/= :: AutoLeader -> AutoLeader -> Bool
== :: AutoLeader -> AutoLeader -> Bool
$c== :: AutoLeader -> AutoLeader -> Bool
Eq, (forall x. AutoLeader -> Rep AutoLeader x)
-> (forall x. Rep AutoLeader x -> AutoLeader) -> Generic AutoLeader
forall x. Rep AutoLeader x -> AutoLeader
forall x. AutoLeader -> Rep AutoLeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AutoLeader x -> AutoLeader
$cfrom :: forall x. AutoLeader -> Rep AutoLeader x
Generic)

instance Binary AutoLeader

teamExplorer :: TeamContinuity
teamExplorer :: TeamContinuity
teamExplorer = Int -> TeamContinuity
TeamContinuity Int
1

victoryOutcomes :: [Outcome]
victoryOutcomes :: [Outcome]
victoryOutcomes = [Outcome
Escape, Outcome
Conquer]

deafeatOutcomes :: [Outcome]
deafeatOutcomes :: [Outcome]
deafeatOutcomes = [Outcome
Defeated, Outcome
Killed, Outcome
Restart]

nameOutcomePast :: Outcome -> Text
nameOutcomePast :: Outcome -> Text
nameOutcomePast = \case
  Outcome
Escape   -> Text
"emerged victorious"
  Outcome
Conquer  -> Text
"vanquished all opposition"
  Outcome
Defeated -> Text
"got decisively defeated"
  Outcome
Killed   -> Text
"got eliminated"
  Outcome
Restart  -> Text
"resigned prematurely"
  Outcome
Camping  -> Text
"set camp"

nameOutcomeVerb :: Outcome -> Text
nameOutcomeVerb :: Outcome -> Text
nameOutcomeVerb = \case
  Outcome
Escape   -> Text
"emerge victorious"
  Outcome
Conquer  -> Text
"vanquish all opposition"
  Outcome
Defeated -> Text
"be decisively defeated"
  Outcome
Killed   -> Text
"be eliminated"
  Outcome
Restart  -> Text
"resign prematurely"
  Outcome
Camping  -> Text
"set camp"

endMessageOutcome :: Outcome -> Text
endMessageOutcome :: Outcome -> Text
endMessageOutcome = \case
  Outcome
Escape   -> Text
"Can it be done more efficiently, though?"
  Outcome
Conquer  -> Text
"Can it be done in a better style, though?"
  Outcome
Defeated -> Text
"Let's hope your new overlords let you live."
  Outcome
Killed   -> Text
"Let's hope a rescue party arrives in time!"
  Outcome
Restart  -> Text
"This time for real."
  Outcome
Camping  -> Text
"See you soon, stronger and braver!"

screensave :: AutoLeader -> ModeKind -> ModeKind
screensave :: AutoLeader -> ModeKind -> ModeKind
screensave AutoLeader
auto ModeKind
mk =
  let f :: (Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
-> (Player, Maybe TeamContinuity,
    [(Int, Dice, GroupName ItemKind)])
f x :: (Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
x@(Player{funderAI :: Player -> Bool
funderAI=Bool
True}, Maybe TeamContinuity
_, [(Int, Dice, GroupName ItemKind)]
_) = (Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
x
      f (Player
player, Maybe TeamContinuity
teamContinuity, [(Int, Dice, GroupName ItemKind)]
initial) =
          ( Player
player { funderAI :: Bool
funderAI = Bool
True
                   , fleaderMode :: Maybe AutoLeader
fleaderMode = AutoLeader -> Maybe AutoLeader
forall a. a -> Maybe a
Just AutoLeader
auto }
          , Maybe TeamContinuity
teamContinuity
          , [(Int, Dice, GroupName ItemKind)]
initial )
  in ModeKind
mk { mroster :: Roster
mroster = (ModeKind -> Roster
mroster ModeKind
mk) {rosterList :: [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterList = ((Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
 -> (Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)]))
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
forall a b. (a -> b) -> [a] -> [b]
map (Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
-> (Player, Maybe TeamContinuity,
    [(Int, Dice, GroupName ItemKind)])
f ([(Player, Maybe TeamContinuity,
   [(Int, Dice, GroupName ItemKind)])]
 -> [(Player, Maybe TeamContinuity,
      [(Int, Dice, GroupName ItemKind)])])
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
forall a b. (a -> b) -> a -> b
$ Roster
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
rosterList (Roster
 -> [(Player, Maybe TeamContinuity,
      [(Int, Dice, GroupName ItemKind)])])
-> Roster
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
forall a b. (a -> b) -> a -> b
$ ModeKind -> Roster
mroster ModeKind
mk}
        , mreason :: Text
mreason = Text
"This is one of the screensaver scenarios, not available from the main menu, with all factions controlled by AI. Feel free to take over or relinquish control at any moment, but to register a legitimate high score, choose a standard scenario instead.\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
mreason ModeKind
mk
        }

-- | Catch invalid game mode kind definitions.
validateSingle :: ModeKind -> [Text]
validateSingle :: ModeKind -> [Text]
validateSingle ModeKind{Bool
Char
Caves
Freqs ModeKind
[(Outcome, Text)]
Text
Roster
mhint :: Text
mreason :: Text
mdesc :: Text
mrules :: Text
mendMsg :: [(Outcome, Text)]
mcaves :: Caves
mroster :: Roster
mtutorial :: Bool
mfreq :: Freqs ModeKind
mname :: Text
msymbol :: Char
mhint :: ModeKind -> Text
mreason :: ModeKind -> Text
mdesc :: ModeKind -> Text
mrules :: ModeKind -> Text
mendMsg :: ModeKind -> [(Outcome, Text)]
mcaves :: ModeKind -> Caves
mroster :: ModeKind -> Roster
mtutorial :: ModeKind -> Bool
mfreq :: ModeKind -> Freqs ModeKind
mname :: ModeKind -> Text
msymbol :: ModeKind -> Char
..} =
  [ Text
"mname longer than 20" | Text -> Int
T.length Text
mname Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20 ]
  [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]
++ Caves -> Roster -> [Text]
validateSingleRoster 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 :: Caves -> Roster -> [Text]
validateSingleRoster :: Caves -> Roster -> [Text]
validateSingleRoster Caves
caves Roster{[(Text, Text)]
[(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterAlly :: [(Text, Text)]
rosterEnemy :: [(Text, Text)]
rosterList :: [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterAlly :: Roster -> [(Text, Text)]
rosterEnemy :: Roster -> [(Text, Text)]
rosterList :: Roster
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
..} =
  [ Text
"no player keeps the dungeon alive"
  | ((Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
 -> Bool)
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Player
pl, Maybe TeamContinuity
_, [(Int, Dice, GroupName ItemKind)]
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Player -> Bool
fneverEmpty Player
pl) [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterList ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"not exactly one UI client"
     | [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
-> Int
forall a. [a] -> Int
length (((Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
 -> Bool)
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Player
pl, Maybe TeamContinuity
_, [(Int, Dice, GroupName ItemKind)]
_) -> Player -> Bool
fhasUI Player
pl) [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterList) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let tokens :: [TeamContinuity]
tokens = ((Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
 -> Maybe TeamContinuity)
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
-> [TeamContinuity]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Player
_, Maybe TeamContinuity
tc, [(Int, Dice, GroupName ItemKind)]
_) -> Maybe TeamContinuity
tc) [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterList
         nubTokens :: [TeamContinuity]
nubTokens = [TeamContinuity] -> [TeamContinuity]
forall a. Eq a => [a] -> [a]
nub ([TeamContinuity] -> [TeamContinuity])
-> [TeamContinuity] -> [TeamContinuity]
forall a b. (a -> b) -> a -> b
$ [TeamContinuity] -> [TeamContinuity]
forall a. Ord a => [a] -> [a]
sort [TeamContinuity]
tokens
     in [ Text
"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]
++ ((Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
 -> [Text])
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
-> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Player
pl, Maybe TeamContinuity
_, [(Int, Dice, GroupName ItemKind)]
_) -> Player -> [Text]
validateSinglePlayer Player
pl) [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterList
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let checkPl :: Text -> Text -> [Text]
checkPl Text
field Text
plName =
           [ Text
plName Text -> Text -> Text
<+> Text
"is not a player name in" Text -> Text -> Text
<+> Text
field
           | ((Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
 -> Bool)
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Player
pl, Maybe TeamContinuity
_, [(Int, Dice, GroupName ItemKind)]
_) -> Player -> Text
fname Player
pl Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
plName) [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterList ]
         checkDipl :: Text -> (Text, Text) -> [Text]
checkDipl Text
field (Text
pl1, Text
pl2) =
           [ Text
"self-diplomacy in" Text -> Text -> Text
<+> Text
field | Text
pl1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
pl2 ]
           [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> Text -> [Text]
checkPl Text
field Text
pl1
           [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> Text -> [Text]
checkPl Text
field Text
pl2
     in ((Text, Text) -> [Text]) -> [(Text, Text)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> (Text, Text) -> [Text]
checkDipl Text
"rosterEnemy") [(Text, Text)]
rosterEnemy
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ((Text, Text) -> [Text]) -> [(Text, Text)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> (Text, Text) -> [Text]
checkDipl Text
"rosterAlly") [(Text, Text)]
rosterAlly
  [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
         minD :: Int
minD = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
keys
         maxD :: Int
maxD = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
keys
         f :: (Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
-> [Text]
f (Player
_, Maybe TeamContinuity
_, [(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 ((Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
 -> [Text])
-> [(Player, Maybe TeamContinuity,
     [(Int, Dice, GroupName ItemKind)])]
-> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])
-> [Text]
f [(Player, Maybe TeamContinuity, [(Int, Dice, GroupName ItemKind)])]
rosterList
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"player confused by both positive and negative level numbers"
           | 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 confused by level numer zero"
           | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) [Int]
keys ]

validateSinglePlayer :: Player -> [Text]
validateSinglePlayer :: Player -> [Text]
validateSinglePlayer Player{Bool
HiCondPoly
[GroupName ItemKind]
Maybe AutoLeader
Text
Doctrine
Skills
funderAI :: Bool
fhasUI :: Bool
fleaderMode :: Maybe AutoLeader
fdoctrine :: Doctrine
fhasGender :: Bool
fhiCondPoly :: HiCondPoly
fneverEmpty :: Bool
fcanEscape :: Bool
fskillsOther :: Skills
fgroups :: [GroupName ItemKind]
fname :: Text
funderAI :: Player -> Bool
fhasUI :: Player -> Bool
fleaderMode :: Player -> Maybe AutoLeader
fdoctrine :: Player -> Doctrine
fhasGender :: Player -> Bool
fhiCondPoly :: Player -> HiCondPoly
fneverEmpty :: Player -> Bool
fcanEscape :: Player -> Bool
fskillsOther :: Player -> Skills
fgroups :: Player -> [GroupName ItemKind]
fname :: Player -> Text
..} =
  [ Text
"fname empty:" Text -> Text -> Text
<+> Text
fname | Text -> Bool
T.null Text
fname ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"fskillsOther not negative:" Text -> Text -> Text
<+> Text
fname
     | ((Skill, Int) -> Bool) -> [(Skill, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Int -> Bool) -> ((Skill, Int) -> Int) -> (Skill, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Skill, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Skill, Int)] -> Bool) -> [(Skill, Int)] -> Bool
forall a b. (a -> b) -> a -> b
$ Skills -> [(Skill, Int)]
Ability.skillsToList Skills
fskillsOther ]

-- | 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 $bCAMPAIGN_SCENARIO :: GroupName ModeKind
$mCAMPAIGN_SCENARIO :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
CAMPAIGN_SCENARIO = GroupName "campaign scenario"
pattern $bINSERT_COIN :: GroupName ModeKind
$mINSERT_COIN :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
INSERT_COIN = GroupName "insert coin"

-- * Optional item groups

pattern NO_CONFIRMS :: GroupName ModeKind

pattern $bNO_CONFIRMS :: GroupName ModeKind
$mNO_CONFIRMS :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
NO_CONFIRMS = GroupName "no confirms"

makeData :: [ModeKind] -> [GroupName ModeKind] -> [GroupName ModeKind]
         -> ContentData ModeKind
makeData :: [ModeKind]
-> [GroupName ModeKind]
-> [GroupName ModeKind]
-> ContentData ModeKind
makeData [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 ModeKind -> [Text]
validateSingle [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)