-- | Basic players definitions.
module Content.ModeKindPlayer
  ( playerHero, playerAntiHero, playerCivilian
  , playerMonster, playerAntiMonster, playerAnimal
  , playerHorror, playerMonsterTourist, playerHunamConvict
  , playerAnimalMagnificent, playerAnimalExquisite
  , hiHeroShort, hiHeroMedium, hiHeroLong, hiDweller
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Content.ItemKindActor
import           Content.ItemKindOrgan
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Definition.Ability

playerHero, playerAntiHero, playerCivilian, playerMonster, playerAntiMonster, playerAnimal, playerHorror, playerMonsterTourist, playerHunamConvict, playerAnimalMagnificent, playerAnimalExquisite :: Player

playerHero :: Player
playerHero = Player :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Maybe AutoLeader
-> Bool
-> Bool
-> Player
Player
  { fname :: Text
fname = Text
"Explorer"
  , fgroups :: [GroupName ItemKind]
fgroups = [GroupName ItemKind
HERO]
  , 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
  , fdoctrine :: Doctrine
fdoctrine = Doctrine
TExplore
  , fleaderMode :: Maybe AutoLeader
fleaderMode = AutoLeader -> Maybe AutoLeader
forall a. a -> Maybe a
Just (AutoLeader -> Maybe AutoLeader) -> AutoLeader -> Maybe AutoLeader
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
False Bool
False
  , fhasUI :: Bool
fhasUI = Bool
True
  , funderAI :: Bool
funderAI = Bool
False
  }

playerAntiHero :: Player
playerAntiHero = Player
playerHero
  { fleaderMode :: Maybe AutoLeader
fleaderMode = AutoLeader -> Maybe AutoLeader
forall a. a -> Maybe a
Just (AutoLeader -> Maybe AutoLeader) -> AutoLeader -> Maybe AutoLeader
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
True Bool
False
  , fhasUI :: Bool
fhasUI = Bool
False
  , funderAI :: Bool
funderAI = Bool
True
  }

playerCivilian :: Player
playerCivilian = Player :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Maybe AutoLeader
-> Bool
-> Bool
-> Player
Player
  { fname :: Text
fname = Text
"Civilian"
  , fgroups :: [GroupName ItemKind]
fgroups = [GroupName ItemKind
HERO, GroupName ItemKind
CIVILIAN]
  , 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
  , fdoctrine :: Doctrine
fdoctrine = Doctrine
TPatrol
  , fleaderMode :: Maybe AutoLeader
fleaderMode = Maybe AutoLeader
forall a. Maybe a
Nothing  -- unorganized
  , fhasUI :: Bool
fhasUI = Bool
False
  , funderAI :: Bool
funderAI = Bool
True
  }

playerMonster :: Player
playerMonster = Player :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Maybe AutoLeader
-> Bool
-> Bool
-> Player
Player
  { fname :: Text
fname = Text
"Monster Hive"
  , fgroups :: [GroupName ItemKind]
fgroups = [GroupName ItemKind
MONSTER, GroupName ItemKind
MOBILE_MONSTER]
  , 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
  , fdoctrine :: Doctrine
fdoctrine = Doctrine
TExplore
  , fleaderMode :: Maybe AutoLeader
fleaderMode =
      -- No point changing leader on level, since all move and they
      -- don't follow the leader.
      AutoLeader -> Maybe AutoLeader
forall a. a -> Maybe a
Just (AutoLeader -> Maybe AutoLeader) -> AutoLeader -> Maybe AutoLeader
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
True Bool
True
  , fhasUI :: Bool
fhasUI = Bool
False
  , funderAI :: Bool
funderAI = Bool
True
  }

playerAntiMonster :: Player
playerAntiMonster = Player
playerMonster
  { fleaderMode :: Maybe AutoLeader
fleaderMode = AutoLeader -> Maybe AutoLeader
forall a. a -> Maybe a
Just (AutoLeader -> Maybe AutoLeader) -> AutoLeader -> Maybe AutoLeader
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
True Bool
True
  , fhasUI :: Bool
fhasUI = Bool
True
  , funderAI :: Bool
funderAI = Bool
False
  }

playerAnimal :: Player
playerAnimal = Player :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Maybe AutoLeader
-> Bool
-> Bool
-> Player
Player
  { fname :: Text
fname = Text
"Animal Kingdom"
  , fgroups :: [GroupName ItemKind]
fgroups = [GroupName ItemKind
ANIMAL, GroupName ItemKind
MOBILE_ANIMAL, GroupName ItemKind
IMMOBILE_ANIMAL, GroupName ItemKind
SCAVENGER]
  , 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
  , fdoctrine :: Doctrine
fdoctrine = Doctrine
TRoam  -- can't pick up, so no point exploring
  , fleaderMode :: Maybe AutoLeader
fleaderMode = Maybe AutoLeader
forall a. Maybe a
Nothing
  , fhasUI :: Bool
fhasUI = Bool
False
  , funderAI :: Bool
funderAI = Bool
True
  }

-- | A special player, for summoned actors that don't belong to any
-- of the main players 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 player should be added to host them.
playerHorror :: Player
playerHorror = Player :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Maybe AutoLeader
-> Bool
-> Bool
-> Player
Player
  { fname :: Text
fname = Text
"Horror Den"
  , fgroups :: [GroupName ItemKind]
fgroups = [GroupName ItemKind
IK.HORROR]
  , fskillsOther :: Skills
fskillsOther = Skills
zeroSkills
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fneverEmpty :: Bool
fneverEmpty = Bool
False
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = []
  , fhasGender :: Bool
fhasGender = Bool
False
  , fdoctrine :: Doctrine
fdoctrine = Doctrine
TPatrol  -- disoriented
  , fleaderMode :: Maybe AutoLeader
fleaderMode = Maybe AutoLeader
forall a. Maybe a
Nothing
  , fhasUI :: Bool
fhasUI = Bool
False
  , funderAI :: Bool
funderAI = Bool
True
  }

playerMonsterTourist :: Player
playerMonsterTourist =
  Player
playerAntiMonster { fname :: Text
fname = Text
"Monster Tourist Office"
                    , fcanEscape :: Bool
fcanEscape = Bool
True
                    , fneverEmpty :: Bool
fneverEmpty = Bool
True  -- no spawning
                    , fhiCondPoly :: HiCondPoly
fhiCondPoly = HiCondPoly
hiHeroMedium
                    , fdoctrine :: Doctrine
fdoctrine = Doctrine
TFollow  -- follow-the-guide, as tourists do
                    , fleaderMode :: Maybe AutoLeader
fleaderMode = AutoLeader -> Maybe AutoLeader
forall a. a -> Maybe a
Just (AutoLeader -> Maybe AutoLeader) -> AutoLeader -> Maybe AutoLeader
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
False Bool
False
                    , funderAI :: Bool
funderAI = Bool
False }

playerHunamConvict :: Player
playerHunamConvict =
  Player
playerCivilian { fname :: Text
fname = Text
"Hunam Convict"
                 , fleaderMode :: Maybe AutoLeader
fleaderMode = AutoLeader -> Maybe AutoLeader
forall a. a -> Maybe a
Just (AutoLeader -> Maybe AutoLeader) -> AutoLeader -> Maybe AutoLeader
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
True Bool
False
                 , funderAI :: Bool
funderAI = Bool
True }

playerAnimalMagnificent :: Player
playerAnimalMagnificent =
  Player
playerAnimal { fname :: Text
fname = Text
"Animal Magnificent Specimen Variety"
               , fneverEmpty :: Bool
fneverEmpty = Bool
True }

playerAnimalExquisite :: Player
playerAnimalExquisite =
  Player
playerAnimal { fname :: Text
fname = Text
"Animal Exquisite Herds and Packs Galore"
               , fneverEmpty :: Bool
fneverEmpty = Bool
True }

hiHeroLong, hiHeroMedium, hiHeroShort, hiDweller :: HiCondPoly

hiHeroShort :: HiCondPoly
hiHeroShort =
  [ ( [(HiIndeterminant
HiLoot, Double
100)]
    , [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound] )
  , ( [(HiIndeterminant
HiConst, Double
100)]
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSprint, -Double
500)]  -- speed matters, but only if fast enough
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSurvival, Double
10)]  -- few points for surviving long
    , [Outcome]
deafeatOutcomes )
  ]

hiHeroMedium :: HiCondPoly
hiHeroMedium =
  [ ( [(HiIndeterminant
HiLoot, Double
200)]  -- usually no loot, but if so, no harm
    , [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound] )
  , ( [(HiIndeterminant
HiConst, Double
200), (HiIndeterminant
HiLoss, -Double
10)]
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSprint, -Double
500)]  -- speed matters, but only if fast enough
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiBlitz, -Double
100)]  -- speed matters always
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSurvival, Double
10)]  -- few points for surviving long
    , [Outcome]
deafeatOutcomes )
  ]

-- Heroes in long crawls rejoice in loot.
hiHeroLong :: HiCondPoly
hiHeroLong =
  [ ( [(HiIndeterminant
HiLoot, Double
10000)]  -- multiplied by fraction of collected
    , [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound] )
  , ( [(HiIndeterminant
HiSprint, -Double
20000)]  -- speedrun bonus, if below this number of turns
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiBlitz, -Double
100)]  -- speed matters always
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSurvival, Double
10)]  -- few points for surviving long
    , [Outcome]
deafeatOutcomes )
  ]

-- Spawners get no points from loot, but try to kill
-- all opponents fast or at least hold up for long.
hiDweller :: HiCondPoly
hiDweller = [ ( [(HiIndeterminant
HiConst, Double
1000)]  -- no loot, so big win reward
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiConst, Double
1000), (HiIndeterminant
HiLoss, -Double
10)]
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiSprint, -Double
1000)]  -- speedrun bonus, if below
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiBlitz, -Double
100)]  -- speed matters
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiSurvival, Double
100)]
              , [Outcome]
deafeatOutcomes )
            ]