-- 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.
--
-- | Basic players definitions.
module Content.ModeKindPlayer
  ( playerHero, playerAntiHero, playerCivilian
  , playerMonster, playerAntiMonster, playerAnimal
  , playerHorror, playerMonsterTourist, playerHunamConvict
  , playerAnimalMagnificent, playerAnimalExquisite
  , hiHeroShort, hiHeroMedium, hiHeroLong, hiDweller
  , playerRobot
  ) 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
playerRobot :: Player

playerHero :: Player
playerHero = $WPlayer :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> LeaderMode
-> Bool
-> Player
Player
  { fname :: Text
fname = "Spacefarer"
  , 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 :: LeaderMode
fleaderMode = AutoLeader -> LeaderMode
LeaderUI (AutoLeader -> LeaderMode) -> AutoLeader -> LeaderMode
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
False Bool
False
  , fhasUI :: Bool
fhasUI = Bool
True
  }

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

playerCivilian :: Player
playerCivilian = $WPlayer :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> LeaderMode
-> Bool
-> Player
Player
  { fname :: Text
fname = "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 :: LeaderMode
fleaderMode = LeaderMode
LeaderNull  -- unorganized
  , fhasUI :: Bool
fhasUI = Bool
False
  }

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

playerAntiMonster :: Player
playerAntiMonster = Player
playerMonster
  { fleaderMode :: LeaderMode
fleaderMode = AutoLeader -> LeaderMode
LeaderUI (AutoLeader -> LeaderMode) -> AutoLeader -> LeaderMode
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
True Bool
True
  , fhasUI :: Bool
fhasUI = Bool
True
  }

playerAnimal :: Player
playerAnimal = $WPlayer :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> LeaderMode
-> Bool
-> Player
Player
  { fname :: Text
fname = "Animal Kingdom"
  , fgroups :: [GroupName ItemKind]
fgroups = [ GroupName ItemKind
ANIMAL, GroupName ItemKind
MOBILE_ANIMAL, GroupName ItemKind
IMMOBILE_ANIMAL, GroupName ItemKind
AQUATIC_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 :: LeaderMode
fleaderMode = LeaderMode
LeaderNull
  , fhasUI :: Bool
fhasUI = Bool
False
  }

-- | 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 = $WPlayer :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> LeaderMode
-> Bool
-> Player
Player
  { fname :: Text
fname = "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 :: LeaderMode
fleaderMode = LeaderMode
LeaderNull
  , fhasUI :: Bool
fhasUI = Bool
False
  }

playerMonsterTourist :: Player
playerMonsterTourist =
  Player
playerAntiMonster { fname :: Text
fname = "Alien 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 :: LeaderMode
fleaderMode = AutoLeader -> LeaderMode
LeaderUI (AutoLeader -> LeaderMode) -> AutoLeader -> LeaderMode
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> AutoLeader
AutoLeader Bool
False Bool
False }

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

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

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

hiHeroLong, hiHeroMedium, hiHeroShort, hiDweller :: HiCondPoly

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

hiHeroMedium :: HiCondPoly
hiHeroMedium =
  [ ( [(HiIndeterminant
HiLoot, 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, 200), (HiIndeterminant
HiLoss, -10)]
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSprint, -500)]  -- speed matters, but only if fast enough
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiBlitz, -100)]  -- speed matters always
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSurvival, 10)]  -- few points for surviving long
    , [Outcome]
deafeatOutcomes )
  ]

-- Heroes in long crawls rejoice in loot.
hiHeroLong :: HiCondPoly
hiHeroLong =
  [ ( [(HiIndeterminant
HiLoot, 10000)]  -- multiplied by fraction of collected
    , [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound] )
  , ( [(HiIndeterminant
HiSprint, -20000)]  -- speedrun bonus, if below this number of turns
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiBlitz, -100)]  -- speed matters always
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSurvival, 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, 1000)]  -- no loot, so big win reward
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiConst, 1000), (HiIndeterminant
HiLoss, -10)]
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiSprint, -1000)]  -- speedrun bonus, if below
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiBlitz, -100)]  -- speed matters
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiSurvival, 100)]
              , [Outcome]
deafeatOutcomes )
            ]

-- Allure-specific

playerRobot :: Player
playerRobot = $WPlayer :: Text
-> [GroupName ItemKind]
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> LeaderMode
-> Bool
-> Player
Player
  { fname :: Text
fname = "Robot Anarchy"
  , fgroups :: [GroupName ItemKind]
fgroups = [ GroupName ItemKind
ROBOT, GroupName ItemKind
MOBILE_ROBOT, GroupName ItemKind
IMMOBILE_ROBOT  --, "aquatic robot"
              , GroupName ItemKind
CONSTRUCTION_ROBOT ]
  , 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
      -- TODO:TFollow -- coordinated via net, follow alien leader
  , fleaderMode :: LeaderMode
fleaderMode = LeaderMode
LeaderNull
  , fhasUI :: Bool
fhasUI = Bool
False
  }