-- Copyright (c) 2008--2011 Andres Loeh
-- Copyright (c) 2010--2021 Mikolaj Konarski and others (see git history)
-- This file is a part of the computer game Allure of the Stars
-- and is released under the terms of the GNU Affero General Public License.
-- For license and copyright information, see the file LICENSE.
--
-- | 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 EXPLORER_EXTERMINATOR, pattern ROBOT_REPRESENTATIVE, pattern ROBOT_CAPTIVE, pattern ROBOT_NARRATING, pattern ROBOT_VIRUS, pattern ROBOT_GAUNTLET, pattern OFF_WORLD_REPRESENTATIVE
  , pattern REPRESENTATIVE
  , pattern ANIMAL_OR_ROBOT_NARRATING
  , groupNamesSingleton, groupNames
  , -- * Content
    content
#ifdef EXPOSE_INTERNAL
  , hiHeroExterminator
#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]
       [GroupName FactionKind]
-> [GroupName FactionKind] -> [GroupName FactionKind]
forall a. [a] -> [a] -> [a]
++ [GroupName FactionKind
EXPLORER_EXTERMINATOR, GroupName FactionKind
ROBOT_REPRESENTATIVE, GroupName FactionKind
ROBOT_CAPTIVE, GroupName FactionKind
ROBOT_NARRATING, GroupName FactionKind
ROBOT_VIRUS, GroupName FactionKind
ROBOT_GAUNTLET, GroupName FactionKind
OFF_WORLD_REPRESENTATIVE]

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

pattern EXPLORER_EXTERMINATOR, ROBOT_REPRESENTATIVE, ROBOT_CAPTIVE, ROBOT_NARRATING, ROBOT_VIRUS, ROBOT_GAUNTLET, OFF_WORLD_REPRESENTATIVE :: GroupName FactionKind

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

-- This pattern was supposed to be used in faction lore to distinguish
-- the faction kinds to show. Instead all factions from the current game
-- are shown. Perhaps in the future we'll also show encountered actions
-- from previous games and then this will be useful to limit the number.
pattern REPRESENTATIVE :: GroupName FactionKind

pattern ANIMAL_OR_ROBOT_NARRATING :: GroupName FactionKind

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

-- ** Allure-specific

pattern $bANIMAL_OR_ROBOT_NARRATING :: GroupName FactionKind
$mANIMAL_OR_ROBOT_NARRATING :: forall r.
GroupName FactionKind -> (Void# -> r) -> (Void# -> r) -> r
ANIMAL_OR_ROBOT_NARRATING = GroupName "animal or robot narrating"

pattern $bEXPLORER_EXTERMINATOR :: GroupName FactionKind
$mEXPLORER_EXTERMINATOR :: forall r.
GroupName FactionKind -> (Void# -> r) -> (Void# -> r) -> r
EXPLORER_EXTERMINATOR = GroupName "explorer exterminator"
pattern $bROBOT_REPRESENTATIVE :: GroupName FactionKind
$mROBOT_REPRESENTATIVE :: forall r.
GroupName FactionKind -> (Void# -> r) -> (Void# -> r) -> r
ROBOT_REPRESENTATIVE = GroupName "robot"
pattern $bROBOT_CAPTIVE :: GroupName FactionKind
$mROBOT_CAPTIVE :: forall r.
GroupName FactionKind -> (Void# -> r) -> (Void# -> r) -> r
ROBOT_CAPTIVE = GroupName "robot captive"
pattern $bROBOT_NARRATING :: GroupName FactionKind
$mROBOT_NARRATING :: forall r.
GroupName FactionKind -> (Void# -> r) -> (Void# -> r) -> r
ROBOT_NARRATING = GroupName "robot narrating"
pattern $bROBOT_VIRUS :: GroupName FactionKind
$mROBOT_VIRUS :: forall r.
GroupName FactionKind -> (Void# -> r) -> (Void# -> r) -> r
ROBOT_VIRUS = GroupName "robot replicant"
pattern $bROBOT_GAUNTLET :: GroupName FactionKind
$mROBOT_GAUNTLET :: forall r.
GroupName FactionKind -> (Void# -> r) -> (Void# -> r) -> r
ROBOT_GAUNTLET = GroupName "robot virus-infested"
pattern $bOFF_WORLD_REPRESENTATIVE :: GroupName FactionKind
$mOFF_WORLD_REPRESENTATIVE :: forall r.
GroupName FactionKind -> (Void# -> r) -> (Void# -> r) -> r
OFF_WORLD_REPRESENTATIVE = GroupName "off-world mercenary"

-- * Teams

teamCompetitor, teamCivilian, teamConvict, teamMonster, teamAnimal, teamHorror, teamRobot, teamOffWorld, 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
teamRobot :: TeamContinuity
teamRobot = Int -> TeamContinuity
TeamContinuity Int
8
teamOffWorld :: TeamContinuity
teamOffWorld = Int -> TeamContinuity
TeamContinuity Int
9
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]
  [FactionKind] -> [FactionKind] -> [FactionKind]
forall a. [a] -> [a] -> [a]
++ [FactionKind
factExplorerExterminator, FactionKind
factRobot, FactionKind
factRobotCaptive, FactionKind
factRobotNarrating, FactionKind
factRobotVirus, FactionKind
factRobotGauntlet, FactionKind
factOffWorld]

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

factExplorerExterminator, factRobot, factRobotCaptive, factRobotNarrating, factRobotVirus, factRobotGauntlet, factOffWorld :: FactionKind

-- * Content

-- ** teamExplorer

factExplorer :: FactionKind
factExplorer = FactionKind :: Text
-> Freqs FactionKind
-> TeamContinuity
-> Freqs ItemKind
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Bool
-> Bool
-> Bool
-> Bool
-> [TeamContinuity]
-> [TeamContinuity]
-> FactionKind
FactionKind
  { fname :: Text
fname = Text
"Spacefarer"
  , 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
teamRobot, TeamContinuity
teamHorror]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }
factExplorerShort :: FactionKind
factExplorerShort = FactionKind
factExplorer
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_SHORT, Int
1)]
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroShort
  }
factExplorerNoEscape :: FactionKind
factExplorerNoEscape = FactionKind
factExplorer
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_NO_ESCAPE, Int
1)]
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroMedium
  }
factExplorerMedium :: FactionKind
factExplorerMedium = FactionKind
factExplorer
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_MEDIUM, Int
1)]
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroMedium
  }
factExplorerTrapped :: FactionKind
factExplorerTrapped = FactionKind
factExplorer
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_TRAPPED, Int
1)]
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroLong
  }
factExplorerAutomated :: FactionKind
factExplorerAutomated = FactionKind
factExplorer
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_AUTOMATED, Int
1)]
  , fhasUI :: Bool
fhasUI = Bool
False
  , finitUnderAI :: Bool
finitUnderAI = Bool
True
  }
factExplorerAutomatedTrapped :: FactionKind
factExplorerAutomatedTrapped = FactionKind
factExplorerAutomated
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_AUTOMATED_TRAPPED, Int
1)]
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroLong
  }
factExplorerCaptive :: FactionKind
factExplorerCaptive = FactionKind
factExplorer
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_CAPTIVE, Int
1)]
  , fneverEmpty :: Bool
fneverEmpty = Bool
True  -- already there
  }
factExplorerPacifist :: FactionKind
factExplorerPacifist = FactionKind
factExplorerCaptive
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_PACIFIST, Int
1)]
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = []
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }

-- ** teamCompetitor, symmetric opponents of teamExplorer

factCompetitor :: FactionKind
factCompetitor = FactionKind
factExplorer
  { fname :: Text
fname = Text
"Red Collar Bro"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
COMPETITOR_REPRESENTATIVE, Int
1), (GroupName FactionKind
REPRESENTATIVE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamCompetitor
  , fhasUI :: Bool
fhasUI = Bool
False
  , finitUnderAI :: Bool
finitUnderAI = Bool
True
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = [TeamContinuity
teamExplorer, TeamContinuity
teamMonster, TeamContinuity
teamAnimal, TeamContinuity
teamRobot, TeamContinuity
teamHorror]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }
factCompetitorShort :: FactionKind
factCompetitorShort = FactionKind
factCompetitor
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
COMPETITOR_SHORT, Int
1)]
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroShort
  }
factCompetitorNoEscape :: FactionKind
factCompetitorNoEscape = FactionKind
factCompetitor
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
COMPETITOR_NO_ESCAPE, Int
1)]
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroMedium
  }

-- ** teamCivilian

factCivilian :: FactionKind
factCivilian = FactionKind :: Text
-> Freqs FactionKind
-> TeamContinuity
-> Freqs ItemKind
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Bool
-> Bool
-> Bool
-> Bool
-> [TeamContinuity]
-> [TeamContinuity]
-> FactionKind
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
teamRobot, TeamContinuity
teamHorror]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }

-- ** teamConvict, different demographics

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

-- ** teamMonster

factMonster :: FactionKind
factMonster = FactionKind :: Text
-> Freqs FactionKind
-> TeamContinuity
-> Freqs ItemKind
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Bool
-> Bool
-> Bool
-> Bool
-> [TeamContinuity]
-> [TeamContinuity]
-> FactionKind
FactionKind
  { fname :: Text
fname = Text
"Alien Hierarchy"
  , 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), (GroupName ItemKind
AQUATIC_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, TeamContinuity
teamRobot]
  }
-- This has continuity @teamMonster@, despite being playable.
factMonsterAnti :: FactionKind
factMonsterAnti = FactionKind
factMonster
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
MONSTER_ANTI, Int
1)]
  , fhasUI :: Bool
fhasUI = Bool
True
  , finitUnderAI :: Bool
finitUnderAI = Bool
False
  }
factMonsterAntiCaptive :: FactionKind
factMonsterAntiCaptive = FactionKind
factMonsterAnti
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
MONSTER_ANTI_CAPTIVE, Int
1)]
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  }
factMonsterAntiPacifist :: FactionKind
factMonsterAntiPacifist = FactionKind
factMonsterAntiCaptive
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
MONSTER_ANTI_PACIFIST, Int
1)]
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = []
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }
-- More flavour and special backstory, but the same team.
factMonsterTourist :: FactionKind
factMonsterTourist = FactionKind
factMonsterAnti
  { fname :: Text
fname = Text
"Alien Tourist Office"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
MONSTER_TOURIST, Int
1)]
  , fcanEscape :: Bool
fcanEscape = Bool
True
  , fneverEmpty :: Bool
fneverEmpty = Bool
True  -- no spawning
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroMedium
  , finitDoctrine :: Doctrine
finitDoctrine = Doctrine
TFollow  -- follow-the-guide, as tourists do
  , fspawnsFast :: Bool
fspawnsFast = Bool
False  -- on a trip, so no spawning
  , finitUnderAI :: Bool
finitUnderAI = Bool
False
  , fenemyTeams :: [TeamContinuity]
fenemyTeams =
      [TeamContinuity
teamAnimal, TeamContinuity
teamExplorer, TeamContinuity
teamCompetitor, TeamContinuity
teamCivilian, TeamContinuity
teamConvict]
  , falliedTeams :: [TeamContinuity]
falliedTeams = [TeamContinuity
teamRobot]
  }
factMonsterTouristPassive :: FactionKind
factMonsterTouristPassive = FactionKind
factMonsterTourist
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
MONSTER_TOURIST_PASSIVE, Int
1)]
  , fhasUI :: Bool
fhasUI = Bool
False
  , finitUnderAI :: Bool
finitUnderAI = Bool
True
  }
factMonsterCaptive :: FactionKind
factMonsterCaptive = FactionKind
factMonster
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
MONSTER_CAPTIVE, Int
1)]
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  }
factMonsterCaptiveNarrating :: FactionKind
factMonsterCaptiveNarrating = FactionKind
factMonsterAntiCaptive
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
MONSTER_CAPTIVE_NARRATING, Int
1)]
  , fhasUI :: Bool
fhasUI = Bool
True
  }

-- ** teamAnimal

factAnimal :: FactionKind
factAnimal = FactionKind :: Text
-> Freqs FactionKind
-> TeamContinuity
-> Freqs ItemKind
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Bool
-> Bool
-> Bool
-> Bool
-> [TeamContinuity]
-> [TeamContinuity]
-> FactionKind
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
AQUATIC_ANIMAL, 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, TeamContinuity
teamRobot]
  }
-- These two differ from outside, but share information and boasting
-- about them tends to be general, too.
factAnimalMagnificent :: FactionKind
factAnimalMagnificent = FactionKind
factAnimal
  { fname :: Text
fname = Text
"Animal Magnificent Specimen Variety"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ANIMAL_MAGNIFICENT, Int
1)]
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  , fenemyTeams :: [TeamContinuity]
fenemyTeams =
      [TeamContinuity
teamMonster, TeamContinuity
teamExplorer, TeamContinuity
teamCompetitor, TeamContinuity
teamCivilian, TeamContinuity
teamConvict]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }
factAnimalExquisite :: FactionKind
factAnimalExquisite = FactionKind
factAnimal
  { fname :: Text
fname = Text
"Animal Exquisite Herds and Packs Galore"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ANIMAL_EXQUISITE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamOther
      -- in the same mode as @factAnimalMagnificent@, so borrow
      -- identity from horrors to avoid a clash
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  , fenemyTeams :: [TeamContinuity]
fenemyTeams =
      [TeamContinuity
teamMonster, TeamContinuity
teamExplorer, TeamContinuity
teamCompetitor, TeamContinuity
teamCivilian, TeamContinuity
teamConvict]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }
factAnimalCaptive :: FactionKind
factAnimalCaptive = FactionKind
factAnimal
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ANIMAL_CAPTIVE, Int
1)]
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  }
factAnimalNarrating :: FactionKind
factAnimalNarrating = FactionKind
factAnimal
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ANIMAL_NARRATING, Int
1), (GroupName FactionKind
ANIMAL_OR_ROBOT_NARRATING, Int
70)]
  , fhasUI :: Bool
fhasUI = Bool
True
  }
factAnimalMagnificentNarrating :: FactionKind
factAnimalMagnificentNarrating = FactionKind
factAnimalMagnificent
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ANIMAL_MAGNIFICENT_NARRATING, Int
1)]
  , fhasPointman :: Bool
fhasPointman = Bool
True
  , fhasUI :: Bool
fhasUI = Bool
True
  , finitUnderAI :: Bool
finitUnderAI = Bool
False
  }
factAnimalCaptiveNarrating :: FactionKind
factAnimalCaptiveNarrating = FactionKind
factAnimalCaptive
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ANIMAL_CAPTIVE_NARRATING, Int
1)]
  , fhasUI :: Bool
fhasUI = Bool
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 :: Text
-> Freqs FactionKind
-> TeamContinuity
-> Freqs ItemKind
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Bool
-> Bool
-> Bool
-> Bool
-> [TeamContinuity]
-> [TeamContinuity]
-> FactionKind
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 :: Freqs FactionKind
ffreq = [(GroupName FactionKind
HORROR_CAPTIVE, Int
1)]
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  }
factHorrorPacifist :: FactionKind
factHorrorPacifist = FactionKind
factHorrorCaptive
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
HORROR_PACIFIST, Int
1)]
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = []
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }

-- * Allure-specific

factExplorerExterminator :: FactionKind
factExplorerExterminator = FactionKind
factExplorer
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
EXPLORER_EXTERMINATOR, Int
1)]
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroExterminator
  }

hiHeroExterminator :: HiCondPoly
hiHeroExterminator :: HiCondPoly
hiHeroExterminator =
  HiCondPoly
hiHeroShort
  HiCondPoly -> HiCondPoly -> HiCondPoly
forall a. [a] -> [a] -> [a]
++ [([(HiIndeterminant
HiConst, Double
200)], [Outcome
Conquer])]  -- bonus for extermination over escape

-- ** teamRobot

factRobot :: FactionKind
factRobot = FactionKind :: Text
-> Freqs FactionKind
-> TeamContinuity
-> Freqs ItemKind
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Bool
-> Bool
-> Bool
-> Bool
-> [TeamContinuity]
-> [TeamContinuity]
-> FactionKind
FactionKind
  { fname :: Text
fname = Text
"Robot Anarchy"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ROBOT_REPRESENTATIVE, Int
1), (GroupName FactionKind
REPRESENTATIVE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamRobot
  , fgroups :: Freqs ItemKind
fgroups = [ (GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
100)
              , (GroupName ItemKind
MOBILE_ROBOT, Int
1), (GroupName ItemKind
IMMOBILE_ROBOT, Int
1)
              , (GroupName ItemKind
CONSTRUCTION_ROBOT, 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
      -- TODO:TFollow -- coordinated via net, follow alien leader
  , 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, TeamContinuity
teamAnimal]
  }
factRobotCaptive :: FactionKind
factRobotCaptive = FactionKind
factRobot
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ROBOT_CAPTIVE, Int
1)]
  , fneverEmpty :: Bool
fneverEmpty = Bool
True
  }
factRobotNarrating :: FactionKind
factRobotNarrating = FactionKind
factRobot
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ROBOT_NARRATING, Int
1), (GroupName FactionKind
ANIMAL_OR_ROBOT_NARRATING, Int
30)]
  , fhasUI :: Bool
fhasUI = Bool
True
  }
factRobotVirus :: FactionKind
factRobotVirus = FactionKind
factRobot
  { fname :: Text
fname = Text
"Replicant Infestation"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ROBOT_VIRUS, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamOther  -- not the same as other robots
  , fgroups :: Freqs ItemKind
fgroups = [(GroupName ItemKind
MOBILE_ROBOT, Int
100)]  -- help assign proper actors to the faction
  , fneverEmpty :: Bool
fneverEmpty = Bool
True  -- faction dissolved when all killed, despite spawning
  , falliedTeams :: [TeamContinuity]
falliedTeams = []  -- cut off, weird
  }
factRobotGauntlet :: FactionKind
factRobotGauntlet = FactionKind
factRobotVirus
  { ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
ROBOT_GAUNTLET, Int
1)]
  , fgroups :: Freqs ItemKind
fgroups = FactionKind -> Freqs ItemKind
fgroups FactionKind
factRobotVirus Freqs ItemKind -> Freqs ItemKind -> Freqs ItemKind
forall a. [a] -> [a] -> [a]
++ [(GroupName ItemKind
GAUNTLET_ROBOT, Int
1)]
      -- keep the faction description the same, despite different composition
  }

-- ** teamOffWorld

factOffWorld :: FactionKind
factOffWorld = FactionKind
factCompetitor
  { fname :: Text
fname = Text
"Gray Off-World Mercenary"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
OFF_WORLD_REPRESENTATIVE, Int
1), (GroupName FactionKind
REPRESENTATIVE, Int
1)]
  , fteam :: TeamContinuity
fteam = TeamContinuity
teamOffWorld
  , fgroups :: Freqs ItemKind
fgroups = [(GroupName ItemKind
MERCENARY_HERO, Int
100)]  -- summoned heroes all go to the player
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroMedium
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = [TeamContinuity
teamExplorer, TeamContinuity
teamMonster, TeamContinuity
teamAnimal, TeamContinuity
teamRobot, TeamContinuity
teamHorror]
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }