-- | Definitions of kinds of factions present in a game, both human
-- and computer-controlled.
module Content.FactionKind
  ( -- * Group name patterns
    pattern EXPLORER_REPRESENTATIVE, pattern EXPLORER_SHORT, pattern EXPLORER_NO_ESCAPE, pattern EXPLORER_MEDIUM, pattern EXPLORER_TRAPPED, pattern EXPLORER_AUTOMATED, pattern EXPLORER_AUTOMATED_TRAPPED, pattern EXPLORER_CAPTIVE, pattern EXPLORER_PACIFIST, pattern COMPETITOR_REPRESENTATIVE, pattern COMPETITOR_SHORT, pattern COMPETITOR_NO_ESCAPE, pattern CIVILIAN_REPRESENTATIVE, pattern CONVICT_REPRESENTATIVE, pattern MONSTER_REPRESENTATIVE, pattern MONSTER_ANTI, pattern MONSTER_ANTI_CAPTIVE, pattern MONSTER_ANTI_PACIFIST, pattern MONSTER_TOURIST, pattern MONSTER_TOURIST_PASSIVE, pattern MONSTER_CAPTIVE, pattern MONSTER_CAPTIVE_NARRATING, pattern ANIMAL_REPRESENTATIVE, pattern ANIMAL_MAGNIFICENT, pattern ANIMAL_EXQUISITE, pattern ANIMAL_CAPTIVE, pattern ANIMAL_NARRATING, pattern ANIMAL_MAGNIFICENT_NARRATING, pattern ANIMAL_CAPTIVE_NARRATING, pattern HORROR_REPRESENTATIVE, pattern HORROR_CAPTIVE, pattern HORROR_PACIFIST
  , pattern REPRESENTATIVE
  , groupNamesSingleton, groupNames
  , -- * Content
    content
#ifdef EXPOSE_INTERNAL
  -- * Group name patterns
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Game.LambdaHack.Content.FactionKind
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Definition.Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.DefsInternal

import Content.ItemKindActor
import Content.ItemKindOrgan

-- * Group name patterns

groupNamesSingleton :: [GroupName FactionKind]
groupNamesSingleton :: [GroupName FactionKind]
groupNamesSingleton =
       [GroupName FactionKind
EXPLORER_REPRESENTATIVE, GroupName FactionKind
EXPLORER_SHORT, GroupName FactionKind
EXPLORER_NO_ESCAPE, GroupName FactionKind
EXPLORER_MEDIUM, GroupName FactionKind
EXPLORER_TRAPPED, GroupName FactionKind
EXPLORER_AUTOMATED, GroupName FactionKind
EXPLORER_AUTOMATED_TRAPPED, GroupName FactionKind
EXPLORER_CAPTIVE, GroupName FactionKind
EXPLORER_PACIFIST, GroupName FactionKind
COMPETITOR_REPRESENTATIVE, GroupName FactionKind
COMPETITOR_SHORT, GroupName FactionKind
COMPETITOR_NO_ESCAPE, GroupName FactionKind
CIVILIAN_REPRESENTATIVE, GroupName FactionKind
CONVICT_REPRESENTATIVE, GroupName FactionKind
MONSTER_REPRESENTATIVE, GroupName FactionKind
MONSTER_ANTI, GroupName FactionKind
MONSTER_ANTI_CAPTIVE, GroupName FactionKind
MONSTER_ANTI_PACIFIST, GroupName FactionKind
MONSTER_TOURIST, GroupName FactionKind
MONSTER_TOURIST_PASSIVE, GroupName FactionKind
MONSTER_CAPTIVE, GroupName FactionKind
MONSTER_CAPTIVE_NARRATING, GroupName FactionKind
ANIMAL_REPRESENTATIVE, GroupName FactionKind
ANIMAL_MAGNIFICENT, GroupName FactionKind
ANIMAL_EXQUISITE, GroupName FactionKind
ANIMAL_CAPTIVE, GroupName FactionKind
ANIMAL_NARRATING, GroupName FactionKind
ANIMAL_MAGNIFICENT_NARRATING, GroupName FactionKind
ANIMAL_CAPTIVE_NARRATING, GroupName FactionKind
HORROR_REPRESENTATIVE, GroupName FactionKind
HORROR_CAPTIVE, GroupName FactionKind
HORROR_PACIFIST]

pattern EXPLORER_REPRESENTATIVE, EXPLORER_SHORT, EXPLORER_NO_ESCAPE, EXPLORER_MEDIUM, EXPLORER_TRAPPED, EXPLORER_AUTOMATED, EXPLORER_AUTOMATED_TRAPPED, EXPLORER_CAPTIVE, EXPLORER_PACIFIST, COMPETITOR_REPRESENTATIVE, COMPETITOR_SHORT, COMPETITOR_NO_ESCAPE, CIVILIAN_REPRESENTATIVE, CONVICT_REPRESENTATIVE, MONSTER_REPRESENTATIVE, MONSTER_ANTI, MONSTER_ANTI_CAPTIVE, MONSTER_ANTI_PACIFIST, MONSTER_TOURIST, MONSTER_TOURIST_PASSIVE, MONSTER_CAPTIVE, MONSTER_CAPTIVE_NARRATING, ANIMAL_REPRESENTATIVE, ANIMAL_MAGNIFICENT, ANIMAL_EXQUISITE, ANIMAL_CAPTIVE, ANIMAL_NARRATING, ANIMAL_MAGNIFICENT_NARRATING, ANIMAL_CAPTIVE_NARRATING, HORROR_REPRESENTATIVE, HORROR_CAPTIVE, HORROR_PACIFIST :: GroupName FactionKind

groupNames :: [GroupName FactionKind]
groupNames :: [GroupName FactionKind]
groupNames = [GroupName FactionKind
REPRESENTATIVE]

pattern REPRESENTATIVE :: GroupName FactionKind

pattern $mREPRESENTATIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bREPRESENTATIVE :: GroupName FactionKind
REPRESENTATIVE = GroupName "representative"
pattern $mEXPLORER_REPRESENTATIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_REPRESENTATIVE :: GroupName FactionKind
EXPLORER_REPRESENTATIVE = GroupName "explorer"
pattern $mEXPLORER_SHORT :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_SHORT :: GroupName FactionKind
EXPLORER_SHORT = GroupName "explorer short"
pattern $mEXPLORER_NO_ESCAPE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_NO_ESCAPE :: GroupName FactionKind
EXPLORER_NO_ESCAPE = GroupName "explorer no escape"
pattern $mEXPLORER_MEDIUM :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_MEDIUM :: GroupName FactionKind
EXPLORER_MEDIUM = GroupName "explorer medium"
pattern $mEXPLORER_TRAPPED :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_TRAPPED :: GroupName FactionKind
EXPLORER_TRAPPED = GroupName "explorer trapped"
pattern $mEXPLORER_AUTOMATED :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_AUTOMATED :: GroupName FactionKind
EXPLORER_AUTOMATED = GroupName "explorer automated"
pattern $mEXPLORER_AUTOMATED_TRAPPED :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_AUTOMATED_TRAPPED :: GroupName FactionKind
EXPLORER_AUTOMATED_TRAPPED = GroupName "explorer automated trapped"
pattern $mEXPLORER_CAPTIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_CAPTIVE :: GroupName FactionKind
EXPLORER_CAPTIVE = GroupName "explorer captive"
pattern $mEXPLORER_PACIFIST :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEXPLORER_PACIFIST :: GroupName FactionKind
EXPLORER_PACIFIST = GroupName "explorer pacifist"
pattern $mCOMPETITOR_REPRESENTATIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCOMPETITOR_REPRESENTATIVE :: GroupName FactionKind
COMPETITOR_REPRESENTATIVE = GroupName "competitor"
pattern $mCOMPETITOR_SHORT :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCOMPETITOR_SHORT :: GroupName FactionKind
COMPETITOR_SHORT = GroupName "competitor short"
pattern $mCOMPETITOR_NO_ESCAPE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCOMPETITOR_NO_ESCAPE :: GroupName FactionKind
COMPETITOR_NO_ESCAPE = GroupName "competitor no escape"
pattern $mCIVILIAN_REPRESENTATIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCIVILIAN_REPRESENTATIVE :: GroupName FactionKind
CIVILIAN_REPRESENTATIVE = GroupName "civilian"
pattern $mCONVICT_REPRESENTATIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCONVICT_REPRESENTATIVE :: GroupName FactionKind
CONVICT_REPRESENTATIVE = GroupName "convict"
pattern $mMONSTER_REPRESENTATIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMONSTER_REPRESENTATIVE :: GroupName FactionKind
MONSTER_REPRESENTATIVE = GroupName "monster"
pattern $mMONSTER_ANTI :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMONSTER_ANTI :: GroupName FactionKind
MONSTER_ANTI = GroupName "monster anti"
pattern $mMONSTER_ANTI_CAPTIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMONSTER_ANTI_CAPTIVE :: GroupName FactionKind
MONSTER_ANTI_CAPTIVE = GroupName "monster anti captive"
pattern $mMONSTER_ANTI_PACIFIST :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMONSTER_ANTI_PACIFIST :: GroupName FactionKind
MONSTER_ANTI_PACIFIST = GroupName "monster anti pacifist"
pattern $mMONSTER_TOURIST :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMONSTER_TOURIST :: GroupName FactionKind
MONSTER_TOURIST = GroupName "monster tourist"
pattern $mMONSTER_TOURIST_PASSIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMONSTER_TOURIST_PASSIVE :: GroupName FactionKind
MONSTER_TOURIST_PASSIVE = GroupName "monster tourist passive"
pattern $mMONSTER_CAPTIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMONSTER_CAPTIVE :: GroupName FactionKind
MONSTER_CAPTIVE = GroupName "monster captive"
pattern $mMONSTER_CAPTIVE_NARRATING :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMONSTER_CAPTIVE_NARRATING :: GroupName FactionKind
MONSTER_CAPTIVE_NARRATING = GroupName "monster captive narrating"
pattern $mANIMAL_REPRESENTATIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bANIMAL_REPRESENTATIVE :: GroupName FactionKind
ANIMAL_REPRESENTATIVE = GroupName "animal"
pattern $mANIMAL_MAGNIFICENT :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bANIMAL_MAGNIFICENT :: GroupName FactionKind
ANIMAL_MAGNIFICENT = GroupName "animal magnificent"
pattern $mANIMAL_EXQUISITE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bANIMAL_EXQUISITE :: GroupName FactionKind
ANIMAL_EXQUISITE = GroupName "animal exquisite"
pattern $mANIMAL_CAPTIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bANIMAL_CAPTIVE :: GroupName FactionKind
ANIMAL_CAPTIVE = GroupName "animal captive"
pattern $mANIMAL_NARRATING :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bANIMAL_NARRATING :: GroupName FactionKind
ANIMAL_NARRATING = GroupName "animal narrating"
pattern $mANIMAL_MAGNIFICENT_NARRATING :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bANIMAL_MAGNIFICENT_NARRATING :: GroupName FactionKind
ANIMAL_MAGNIFICENT_NARRATING = GroupName "animal magnificent narrating"
pattern $mANIMAL_CAPTIVE_NARRATING :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bANIMAL_CAPTIVE_NARRATING :: GroupName FactionKind
ANIMAL_CAPTIVE_NARRATING = GroupName "animal captive narrating"
pattern $mHORROR_REPRESENTATIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bHORROR_REPRESENTATIVE :: GroupName FactionKind
HORROR_REPRESENTATIVE = GroupName "horror"
pattern $mHORROR_CAPTIVE :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bHORROR_CAPTIVE :: GroupName FactionKind
HORROR_CAPTIVE = GroupName "horror captive"
pattern $mHORROR_PACIFIST :: forall {r}.
GroupName FactionKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bHORROR_PACIFIST :: GroupName FactionKind
HORROR_PACIFIST = GroupName "horror pacifist"

-- * Teams

teamCompetitor, teamCivilian, teamConvict, teamMonster, teamAnimal, teamHorror, teamOther :: TeamContinuity
teamCompetitor :: TeamContinuity
teamCompetitor = Int -> TeamContinuity
TeamContinuity Int
2
teamCivilian :: TeamContinuity
teamCivilian = Int -> TeamContinuity
TeamContinuity Int
3
teamConvict :: TeamContinuity
teamConvict = Int -> TeamContinuity
TeamContinuity Int
4
teamMonster :: TeamContinuity
teamMonster = Int -> TeamContinuity
TeamContinuity Int
5
teamAnimal :: TeamContinuity
teamAnimal = Int -> TeamContinuity
TeamContinuity Int
6
teamHorror :: TeamContinuity
teamHorror = Int -> TeamContinuity
TeamContinuity Int
7
teamOther :: TeamContinuity
teamOther = Int -> TeamContinuity
TeamContinuity Int
10

-- * Content

content :: [FactionKind]
content :: [FactionKind]
content = [FactionKind
factExplorer, FactionKind
factExplorerShort, FactionKind
factExplorerNoEscape, FactionKind
factExplorerMedium, FactionKind
factExplorerTrapped, FactionKind
factExplorerAutomated, FactionKind
factExplorerAutomatedTrapped, FactionKind
factExplorerCaptive, FactionKind
factExplorerPacifist, FactionKind
factCompetitor, FactionKind
factCompetitorShort, FactionKind
factCompetitorNoEscape, FactionKind
factCivilian, FactionKind
factConvict, FactionKind
factMonster, FactionKind
factMonsterAnti, FactionKind
factMonsterAntiCaptive, FactionKind
factMonsterAntiPacifist, FactionKind
factMonsterTourist, FactionKind
factMonsterTouristPassive, FactionKind
factMonsterCaptive, FactionKind
factMonsterCaptiveNarrating, FactionKind
factAnimal, FactionKind
factAnimalMagnificent, FactionKind
factAnimalExquisite, FactionKind
factAnimalCaptive, FactionKind
factAnimalNarrating, FactionKind
factAnimalMagnificentNarrating, FactionKind
factAnimalCaptiveNarrating, FactionKind
factHorror, FactionKind
factHorrorCaptive, FactionKind
factHorrorPacifist]

factExplorer,            factExplorerShort, factExplorerNoEscape, factExplorerMedium, factExplorerTrapped, factExplorerAutomated, factExplorerAutomatedTrapped, factExplorerCaptive, factExplorerPacifist, factCompetitor, factCompetitorShort, factCompetitorNoEscape, factCivilian, factConvict, factMonster, factMonsterAnti, factMonsterAntiCaptive, factMonsterAntiPacifist, factMonsterTourist, factMonsterTouristPassive, factMonsterCaptive, factMonsterCaptiveNarrating, factAnimal, factAnimalMagnificent, factAnimalExquisite, factAnimalCaptive, factAnimalNarrating, factAnimalMagnificentNarrating, factAnimalCaptiveNarrating, factHorror, factHorrorCaptive, factHorrorPacifist :: FactionKind

-- * Content

-- ** teamExplorer

factExplorer :: FactionKind
factExplorer = FactionKind
  { fname :: Text
fname = Text
"Explorer"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_REPRESENTATIVE, Int
1), (GroupName FactionKind
REPRESENTATIVE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamExplorer
  , fgroups :: Freqs ItemKind
fgroups = [(GroupName ItemKind
HERO, Int
100)]  -- don't spam the escapists, etc., in description
  , fskillsOther :: Skills
fskillsOther = Skills
meleeAdjacent
  , fcanEscape :: Bool
fcanEscape = Bool
True
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroLong
  , fhasGender :: Bool
fhasGender = Bool
True
  , finitDoctrine :: Doctrine
finitDoctrine = Doctrine
TExplore
  , fspawnsFast :: Bool
fspawnsFast = Bool
False
  , fhasPointman :: Bool
fhasPointman = Bool
True
  , fhasUI :: Bool
fhasUI = Bool
True
  , finitUnderAI :: Bool
finitUnderAI = Bool
False
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = [TeamContinuity
teamCompetitor, TeamContinuity
teamMonster, TeamContinuity
teamAnimal, TeamContinuity
teamHorror]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }
factExplorerShort :: FactionKind
factExplorerShort = FactionKind
factExplorer
  { ffreq = [(EXPLORER_SHORT, 1)]
  , fhiCondPoly = hiHeroShort
  , fenemyTeams = [teamMonster, teamAnimal, teamHorror]
  }
factExplorerNoEscape :: FactionKind
factExplorerNoEscape = FactionKind
factExplorer
  { ffreq = [(EXPLORER_NO_ESCAPE, 1)]
  , fcanEscape = False
  , fhiCondPoly = hiHeroMedium
  }
factExplorerMedium :: FactionKind
factExplorerMedium = FactionKind
factExplorer
  { ffreq = [(EXPLORER_MEDIUM, 1)]
  , fhiCondPoly = hiHeroMedium
  }
factExplorerTrapped :: FactionKind
factExplorerTrapped = FactionKind
factExplorer
  { ffreq = [(EXPLORER_TRAPPED, 1)]
  , fcanEscape = False
  , fhiCondPoly = hiHeroLong
  }
factExplorerAutomated :: FactionKind
factExplorerAutomated = FactionKind
factExplorer
  { ffreq = [(EXPLORER_AUTOMATED, 1)]
  , fhasUI = False
  , finitUnderAI = True
  }
factExplorerAutomatedTrapped :: FactionKind
factExplorerAutomatedTrapped = FactionKind
factExplorerAutomated
  { ffreq = [(EXPLORER_AUTOMATED_TRAPPED, 1)]
  , fcanEscape = False
  , fhiCondPoly = hiHeroLong
  }
factExplorerCaptive :: FactionKind
factExplorerCaptive = FactionKind
factExplorer
  { ffreq = [(EXPLORER_CAPTIVE, 1)]
  , fneverEmpty = True  -- already there
  }
factExplorerPacifist :: FactionKind
factExplorerPacifist = FactionKind
factExplorerCaptive
  { ffreq = [(EXPLORER_PACIFIST, 1)]
  , fenemyTeams = []
  , falliedTeams = []
  }

-- ** teamCompetitor, symmetric opponents of teamExplorer

factCompetitor :: FactionKind
factCompetitor = FactionKind
factExplorer
  { fname = "Indigo Researcher"
  , ffreq = [(COMPETITOR_REPRESENTATIVE, 1), (REPRESENTATIVE, 1)]
  , fteam = teamCompetitor
  , fhasUI = False
  , finitUnderAI = True
  , fenemyTeams = [teamExplorer, teamMonster, teamAnimal, teamHorror]
  , falliedTeams = []
  }
factCompetitorShort :: FactionKind
factCompetitorShort = FactionKind
factCompetitor
  { fname = "Indigo Founder"  -- early
  , ffreq = [(COMPETITOR_SHORT, 1)]
  , fhiCondPoly = hiHeroShort
  , fenemyTeams = [teamMonster, teamAnimal, teamHorror]
  }
factCompetitorNoEscape :: FactionKind
factCompetitorNoEscape = FactionKind
factCompetitor
  { ffreq = [(COMPETITOR_NO_ESCAPE, 1)]
  , fcanEscape = False
  , fhiCondPoly = hiHeroMedium
  }

-- ** teamCivilian

factCivilian :: FactionKind
factCivilian = FactionKind
  { fname :: Text
fname = Text
"Civilian"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
CIVILIAN_REPRESENTATIVE, Int
1), (GroupName FactionKind
REPRESENTATIVE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamCivilian
  , fgroups :: Freqs ItemKind
fgroups = [(GroupName ItemKind
HERO, Int
100), (GroupName ItemKind
CIVILIAN, Int
100)]  -- symmetric vs player
  , fskillsOther :: Skills
fskillsOther = Skills
zeroSkills  -- not coordinated by any leadership
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroMedium
  , fhasGender :: Bool
fhasGender = Bool
True
  , finitDoctrine :: Doctrine
finitDoctrine = Doctrine
TPatrol
  , fspawnsFast :: Bool
fspawnsFast = Bool
False
  , fhasPointman :: Bool
fhasPointman = Bool
False  -- unorganized
  , fhasUI :: Bool
fhasUI = Bool
False
  , finitUnderAI :: Bool
finitUnderAI = Bool
True
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = [TeamContinuity
teamMonster, TeamContinuity
teamAnimal, TeamContinuity
teamHorror]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }

-- ** teamConvict, different demographics

factConvict :: FactionKind
factConvict = FactionKind
factCivilian
  { fname = "Hunam Convict"
  , ffreq = [(CONVICT_REPRESENTATIVE, 1), (REPRESENTATIVE, 1)]
  , fteam = teamConvict
  , fhasPointman = True  -- convicts organize better
  , finitUnderAI = True
  , fenemyTeams = [teamMonster, teamAnimal, teamHorror]
  , falliedTeams = []
  }

-- ** teamMonster

factMonster :: FactionKind
factMonster = FactionKind
  { fname :: Text
fname = Text
"Monster Hive"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
MONSTER_REPRESENTATIVE, Int
1), (GroupName FactionKind
REPRESENTATIVE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamMonster
  , fgroups :: Freqs ItemKind
fgroups = [ (GroupName ItemKind
MONSTER, Int
100)
              , (GroupName ItemKind
MOBILE_MONSTER, Int
1) ]
  , fskillsOther :: Skills
fskillsOther = Skills
zeroSkills
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fneverEmpty :: Bool
fneverEmpty = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiDweller
  , fhasGender :: Bool
fhasGender = Bool
False
  , finitDoctrine :: Doctrine
finitDoctrine = Doctrine
TExplore
  , fspawnsFast :: Bool
fspawnsFast = Bool
True
  , fhasPointman :: Bool
fhasPointman = Bool
True
  , fhasUI :: Bool
fhasUI = Bool
False
  , finitUnderAI :: Bool
finitUnderAI = Bool
True
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = [TeamContinuity
teamExplorer, TeamContinuity
teamCompetitor, TeamContinuity
teamCivilian, TeamContinuity
teamConvict]
  , falliedTeams :: [TeamContinuity]
falliedTeams = [TeamContinuity
teamAnimal]
  }
-- This has continuity @teamMonster@, despite being playable.
factMonsterAnti :: FactionKind
factMonsterAnti = FactionKind
factMonster
  { ffreq = [(MONSTER_ANTI, 1)]
  , fhasUI = True
  , finitUnderAI = False
  }
factMonsterAntiCaptive :: FactionKind
factMonsterAntiCaptive = FactionKind
factMonsterAnti
  { ffreq = [(MONSTER_ANTI_CAPTIVE, 1)]
  , fneverEmpty = True
  }
factMonsterAntiPacifist :: FactionKind
factMonsterAntiPacifist = FactionKind
factMonsterAntiCaptive
  { ffreq = [(MONSTER_ANTI_PACIFIST, 1)]
  , fenemyTeams = []
  , falliedTeams = []
  }
-- More flavour and special backstory, but the same team.
factMonsterTourist :: FactionKind
factMonsterTourist = FactionKind
factMonsterAnti
  { fname = "Monster Tourist Office"
  , ffreq = [(MONSTER_TOURIST, 1)]
  , fcanEscape = True
  , fneverEmpty = True  -- no spawning
  , fhiCondPoly = hiHeroMedium
  , finitDoctrine = TFollow  -- follow-the-guide, as tourists do
  , fspawnsFast = False  -- on a trip, so no spawning
  , finitUnderAI = False
  , fenemyTeams =
      [teamAnimal, teamExplorer, teamCompetitor, teamCivilian, teamConvict]
  , falliedTeams = []
  }
factMonsterTouristPassive :: FactionKind
factMonsterTouristPassive = FactionKind
factMonsterTourist
  { ffreq = [(MONSTER_TOURIST_PASSIVE, 1)]
  , fhasUI = False
  , finitUnderAI = True
  }
factMonsterCaptive :: FactionKind
factMonsterCaptive = FactionKind
factMonster
  { ffreq = [(MONSTER_CAPTIVE, 1)]
  , fneverEmpty = True
  }
factMonsterCaptiveNarrating :: FactionKind
factMonsterCaptiveNarrating = FactionKind
factMonsterAntiCaptive
  { ffreq = [(MONSTER_CAPTIVE_NARRATING, 1)]
  , fhasUI = True
  }

-- ** teamAnimal

factAnimal :: FactionKind
factAnimal = FactionKind
  { fname :: Text
fname = Text
"Animal Kingdom"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ANIMAL_REPRESENTATIVE, Int
1), (GroupName FactionKind
REPRESENTATIVE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamAnimal
  , fgroups :: Freqs ItemKind
fgroups = [ (GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
INSECT, Int
100), (GroupName ItemKind
GEOPHENOMENON, Int
100)
                   -- only the distinct enough ones
              , (GroupName ItemKind
MOBILE_ANIMAL, Int
1), (GroupName ItemKind
IMMOBILE_ANIMAL, Int
1), (GroupName ItemKind
SCAVENGER, Int
1) ]
  , fskillsOther :: Skills
fskillsOther = Skills
zeroSkills
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fneverEmpty :: Bool
fneverEmpty = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiDweller
  , fhasGender :: Bool
fhasGender = Bool
False
  , finitDoctrine :: Doctrine
finitDoctrine = Doctrine
TRoam  -- can't pick up, so no point exploring
  , fspawnsFast :: Bool
fspawnsFast = Bool
True
  , fhasPointman :: Bool
fhasPointman = Bool
False
  , fhasUI :: Bool
fhasUI = Bool
False
  , finitUnderAI :: Bool
finitUnderAI = Bool
True
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = [TeamContinuity
teamExplorer, TeamContinuity
teamCompetitor, TeamContinuity
teamCivilian, TeamContinuity
teamConvict]
  , falliedTeams :: [TeamContinuity]
falliedTeams = [TeamContinuity
teamMonster]
  }
-- These two differ from outside, but share information and boasting
-- about them tends to be general, too.
factAnimalMagnificent :: FactionKind
factAnimalMagnificent = FactionKind
factAnimal
  { fname = "Animal Magnificent Specimen Variety"
  , ffreq = [(ANIMAL_MAGNIFICENT, 1)]
  , fneverEmpty = True
  , fenemyTeams =
      [teamMonster, teamExplorer, teamCompetitor, teamCivilian, teamConvict]
  , falliedTeams = []
  }
factAnimalExquisite :: FactionKind
factAnimalExquisite = FactionKind
factAnimal
  { fname = "Animal Exquisite Herds and Packs Galore"
  , ffreq = [(ANIMAL_EXQUISITE, 1)]
  , fteam = teamOther
      -- in the same mode as @factAnimalMagnificent@, so borrow
      -- identity from horrors to avoid a clash
  , fneverEmpty = True
  , fenemyTeams =
      [teamMonster, teamExplorer, teamCompetitor, teamCivilian, teamConvict]
  , falliedTeams = []
  }
factAnimalCaptive :: FactionKind
factAnimalCaptive = FactionKind
factAnimal
  { ffreq = [(ANIMAL_CAPTIVE, 1)]
  , fneverEmpty = True
  }
factAnimalNarrating :: FactionKind
factAnimalNarrating = FactionKind
factAnimal
  { ffreq = [(ANIMAL_NARRATING, 1)]
  , fhasUI = True
  }
factAnimalMagnificentNarrating :: FactionKind
factAnimalMagnificentNarrating = FactionKind
factAnimalMagnificent
  { ffreq = [(ANIMAL_MAGNIFICENT_NARRATING, 1)]
  , fhasPointman = True
  , fhasUI = True
  , finitUnderAI = False
  }
factAnimalCaptiveNarrating :: FactionKind
factAnimalCaptiveNarrating = FactionKind
factAnimalCaptive
  { ffreq = [(ANIMAL_CAPTIVE_NARRATING, 1)]
  , fhasUI = True
  }

-- ** teamHorror, not much of a continuity intended, but can't be ignored

-- | A special faction, for summoned actors that don't belong to any
-- of the main factions of a given game. E.g., animals summoned during
-- a brawl game between two hero factions land in the horror faction.
-- In every game, either all factions for which summoning items exist
-- should be present or a horror faction should be added to host them.
factHorror :: FactionKind
factHorror = FactionKind
  { fname :: Text
fname = Text
"Horror Den"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
HORROR_REPRESENTATIVE, Int
1), (GroupName FactionKind
REPRESENTATIVE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamHorror
  , fgroups :: Freqs ItemKind
fgroups = [(GroupName ItemKind
IK.HORROR, Int
100)]
  , fskillsOther :: Skills
fskillsOther = Skills
zeroSkills
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fneverEmpty :: Bool
fneverEmpty = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = []
  , fhasGender :: Bool
fhasGender = Bool
False
  , finitDoctrine :: Doctrine
finitDoctrine = Doctrine
TPatrol  -- disoriented
  , fspawnsFast :: Bool
fspawnsFast = Bool
False
  , fhasPointman :: Bool
fhasPointman = Bool
False
  , fhasUI :: Bool
fhasUI = Bool
False
  , finitUnderAI :: Bool
finitUnderAI = Bool
True
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = [TeamContinuity
teamExplorer, TeamContinuity
teamCompetitor, TeamContinuity
teamCivilian, TeamContinuity
teamConvict]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }
factHorrorCaptive :: FactionKind
factHorrorCaptive = FactionKind
factHorror
  { ffreq = [(HORROR_CAPTIVE, 1)]
  , fneverEmpty = True
  }
factHorrorPacifist :: FactionKind
factHorrorPacifist = FactionKind
factHorrorCaptive
  { ffreq = [(HORROR_PACIFIST, 1)]
  , fenemyTeams = []
  , falliedTeams = []
  }