module Game.LambdaHack.Common.Faction
( FactionId, FactionDict, Faction(..), Diplomacy(..), Outcome(..), Status(..)
, isSpawnFact, isSummonFact, isAtWar, isAllied
) where
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import Data.Text (Text)
import Game.LambdaHack.Common.Actor
import qualified Game.LambdaHack.Common.Color as Color
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Content.FactionKind
import Game.LambdaHack.Content.ModeKind
type FactionDict = EM.EnumMap FactionId Faction
data Faction = Faction
{ gkind :: !(Kind.Id FactionKind)
, gname :: !Text
, gcolor :: !Color.Color
, gplayer :: !Player
, gdipl :: !Dipl
, gquit :: !(Maybe Status)
, gleader :: !(Maybe ActorId)
}
deriving (Show, Eq)
data Diplomacy =
Unknown
| Neutral
| Alliance
| War
deriving (Show, Eq, Ord)
type Dipl = EM.EnumMap FactionId Diplomacy
data Outcome =
Killed
| Defeated
| Camping
| Conquer
| Escape
| Restart
deriving (Show, Eq, Ord)
data Status = Status
{ stOutcome :: !Outcome
, stDepth :: !Int
, stInfo :: !Text
}
deriving (Show, Eq, Ord)
isSpawnFact :: Kind.COps -> Faction -> Bool
isSpawnFact Kind.COps{cofaction=Kind.Ops{okind}} fact =
let kind = okind (gkind fact)
in maybe False (> 0) $ lookup "spawn" $ ffreq kind
isSummonFact :: Kind.COps -> Faction -> Bool
isSummonFact Kind.COps{cofaction=Kind.Ops{okind}} fact =
let kind = okind (gkind fact)
in maybe False (> 0) $ lookup "summon" $ ffreq kind
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)
instance Binary Faction where
put Faction{..} = do
put gkind
put gname
put gcolor
put gplayer
put gdipl
put gquit
put gleader
get = do
gkind <- get
gname <- get
gcolor <- get
gplayer <- get
gdipl <- get
gquit <- get
gleader <- get
return Faction{..}
instance Binary Diplomacy where
put Unknown = putWord8 0
put Neutral = putWord8 1
put Alliance = putWord8 2
put War = putWord8 3
get = do
tag <- getWord8
case tag of
0 -> return Unknown
1 -> return Neutral
2 -> return Alliance
3 -> return War
_ -> fail "no parse (Diplomacy)"
instance Binary Outcome where
put Killed = putWord8 0
put Defeated = putWord8 1
put Camping = putWord8 2
put Conquer = putWord8 3
put Escape = putWord8 4
put Restart = putWord8 5
get = do
tag <- getWord8
case tag of
0 -> return Killed
1 -> return Defeated
2 -> return Camping
3 -> return Conquer
4 -> return Escape
5 -> return Restart
_ -> fail "no parse (Outcome)"
instance Binary Status where
put Status{..} = do
put stOutcome
put stDepth
put stInfo
get = do
stOutcome <- get
stDepth <- get
stInfo <- get
return Status{..}