module Game.LambdaHack.Common.Faction
( FactionId, FactionDict, Faction(..), Diplomacy(..), Outcome(..), Status(..)
, Target(..)
, isHorrorFact
, canMoveFact, noRunWithMulti, isAIFact, autoDungeonLevel, automatePlayer
, isAtWar, isAllied
, difficultyBound, difficultyDefault, difficultyCoeff
#ifdef EXPOSE_INTERNAL
, Dipl
#endif
) where
import Control.Monad
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import Data.Text (Text)
import qualified Game.LambdaHack.Common.Ability as Ability
import Game.LambdaHack.Common.Actor
import qualified Game.LambdaHack.Common.Color as Color
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Content.ModeKind
type FactionDict = EM.EnumMap FactionId Faction
data Faction = Faction
{ gname :: !Text
, gcolor :: !Color.Color
, gplayer :: !Player
, gdipl :: !Dipl
, gquit :: !(Maybe Status)
, gleader :: !(Maybe (ActorId, Maybe Target))
, gsha :: !ItemBag
, gvictims :: !(EM.EnumMap (Kind.Id ItemKind) Int)
}
deriving (Show, Eq)
data Diplomacy =
Unknown
| Neutral
| Alliance
| War
deriving (Show, Eq, Ord, Enum)
type Dipl = EM.EnumMap FactionId Diplomacy
data Outcome =
Killed
| Defeated
| Camping
| Conquer
| Escape
| Restart
deriving (Show, Eq, Ord, Enum)
data Status = Status
{ stOutcome :: !Outcome
, stDepth :: !Int
, stNewGame :: !(Maybe GroupName)
}
deriving (Show, Eq, Ord)
data Target =
TEnemy !ActorId !Bool
| TEnemyPos !ActorId !LevelId !Point !Bool
| TPoint !LevelId !Point
| TVector !Vector
deriving (Show, Eq)
isHorrorFact :: Faction -> Bool
isHorrorFact fact = fgroup (gplayer fact) == "horror"
canMoveFact :: Faction -> Bool -> Bool
canMoveFact fact isLeader =
let skillsOther = fskillsOther $ gplayer fact
in if isLeader
then True
else EM.findWithDefault 0 Ability.AbMove skillsOther > 0
noRunWithMulti :: Faction -> Bool
noRunWithMulti fact =
let skillsOther = fskillsOther $ gplayer fact
in EM.findWithDefault 0 Ability.AbMove skillsOther > 0
|| case fleaderMode (gplayer fact) of
LeaderNull -> True
LeaderAI AutoLeader{} -> True
LeaderUI AutoLeader{..} -> autoDungeon || autoLevel
isAIFact :: Faction -> Bool
isAIFact fact =
case fleaderMode (gplayer fact) of
LeaderNull -> True
LeaderAI _ -> True
LeaderUI _ -> False
autoDungeonLevel :: Faction -> (Bool, Bool)
autoDungeonLevel fact = case fleaderMode (gplayer fact) of
LeaderNull -> (False, False)
LeaderAI AutoLeader{..} -> (autoDungeon, autoLevel)
LeaderUI AutoLeader{..} -> (autoDungeon, autoLevel)
automatePlayer :: Bool -> Player -> Player
automatePlayer st pl =
let autoLeader False Player{fleaderMode=LeaderAI auto} = LeaderUI auto
autoLeader True Player{fleaderMode=LeaderUI auto} = LeaderAI auto
autoLeader _ Player{fleaderMode} = fleaderMode
in pl {fleaderMode = autoLeader st pl}
isAtWar :: Faction -> FactionId -> Bool
isAtWar fact fid = War == EM.findWithDefault Unknown fid (gdipl fact)
isAllied :: Faction -> FactionId -> Bool
isAllied fact fid = Alliance == EM.findWithDefault Unknown fid (gdipl fact)
difficultyBound :: Int
difficultyBound = 9
difficultyDefault :: Int
difficultyDefault = (1 + difficultyBound) `div` 2
difficultyCoeff :: Int -> Int
difficultyCoeff n = difficultyDefault n
instance Binary Faction where
put Faction{..} = do
put gname
put gcolor
put gplayer
put gdipl
put gquit
put gleader
put gsha
put gvictims
get = do
gname <- get
gcolor <- get
gplayer <- get
gdipl <- get
gquit <- get
gleader <- get
gsha <- get
gvictims <- get
return $! Faction{..}
instance Binary Diplomacy where
put = putWord8 . toEnum . fromEnum
get = fmap (toEnum . fromEnum) getWord8
instance Binary Outcome where
put = putWord8 . toEnum . fromEnum
get = fmap (toEnum . fromEnum) getWord8
instance Binary Status where
put Status{..} = do
put stOutcome
put stDepth
put stNewGame
get = do
stOutcome <- get
stDepth <- get
stNewGame <- get
return $! Status{..}
instance Binary Target where
put (TEnemy a permit) = putWord8 0 >> put a >> put permit
put (TEnemyPos a lid p permit) =
putWord8 1 >> put a >> put lid >> put p >> put permit
put (TPoint lid p) = putWord8 2 >> put lid >> put p
put (TVector v) = putWord8 3 >> put v
get = do
tag <- getWord8
case tag of
0 -> liftM2 TEnemy get get
1 -> liftM4 TEnemyPos get get get get
2 -> liftM2 TPoint get get
3 -> liftM TVector get
_ -> fail "no parse (Target)"