module Game.LambdaHack.Common.Actor
(
ActorId, monsterGenChance, partActor, partPronoun
, Actor(..), ResDelta(..)
, deltaSerious, deltaMild, xM, minusM, minusTwoM, oneM
, bspeed, actorTemplate, braced, waitedLastTurn
, actorDying, actorNewBorn, unoccupied
, hpTooLow, hpHuge, calmEnough, calmEnough10, hpEnough, hpEnough10
, ActorDict, smellTimeout, checkAdjacent
, keySelected, ppContainer, ppCStore, ppCStoreIn, verbCStore
) where
import Control.Exception.Assert.Sugar
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import Data.Int (Int64)
import Data.Maybe
import Data.Ratio
import Data.Text (Text)
import qualified NLP.Miniutter.English as MU
import qualified Game.LambdaHack.Common.Color as Color
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemStrongest
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
data Actor = Actor
{
btrunk :: !ItemId
, bsymbol :: !Char
, bname :: !Text
, bpronoun :: !Text
, bcolor :: !Color.Color
, btime :: !Time
, bhp :: !Int64
, bhpDelta :: !ResDelta
, bcalm :: !Int64
, bcalmDelta :: !ResDelta
, bpos :: !Point
, boldpos :: !(Maybe Point)
, blid :: !LevelId
, boldlid :: !LevelId
, bfid :: !FactionId
, bfidImpressed :: !FactionId
, bfidOriginal :: !FactionId
, btrajectory :: !(Maybe ([Vector], Speed))
, borgan :: !ItemBag
, beqp :: !ItemBag
, binv :: !ItemBag
, bwait :: !Bool
, bproj :: !Bool
}
deriving (Show, Eq)
data ResDelta = ResDelta
{ resCurrentTurn :: !Int64
, resPreviousTurn :: !Int64
}
deriving (Show, Eq)
deltaSerious :: ResDelta -> Bool
deltaSerious ResDelta{..} = resCurrentTurn < minusM || resPreviousTurn < minusM
deltaMild :: ResDelta -> Bool
deltaMild ResDelta{..} = resCurrentTurn == minusM || resPreviousTurn == minusM
xM :: Int -> Int64
xM k = fromIntegral k * 1000000
minusM, minusTwoM, oneM :: Int64
minusM = xM (1)
minusTwoM = xM (2)
oneM = xM 1
monsterGenChance :: AbsDepth -> AbsDepth -> Int -> Int -> Rnd Bool
monsterGenChance _ _ _ 0 = return False
monsterGenChance (AbsDepth n) (AbsDepth totalDepth) lvlSpawned actorCoeff =
assert (totalDepth > 0 && n > 0)
$ let scaledDepth = n * 10 `div` totalDepth
numSpawnedCoeff = lvlSpawned `div` 2
in chance $ 1%(fromIntegral
((actorCoeff * (numSpawnedCoeff scaledDepth))
`max` 1))
partActor :: Actor -> MU.Part
partActor b = MU.Text $ bname b
partPronoun :: Actor -> MU.Part
partPronoun b = MU.Text $ bpronoun b
actorTemplate :: ItemId -> Char -> Text -> Text
-> Color.Color -> Int64 -> Int64
-> Point -> LevelId -> Time -> FactionId
-> Actor
actorTemplate btrunk bsymbol bname bpronoun bcolor bhp bcalm
bpos blid btime bfid =
let btrajectory = Nothing
boldpos = Nothing
boldlid = blid
beqp = EM.empty
binv = EM.empty
borgan = EM.empty
bwait = False
bfidImpressed = bfid
bfidOriginal = bfid
bhpDelta = ResDelta 0 0
bcalmDelta = ResDelta 0 0
bproj = False
in Actor{..}
bspeed :: Actor -> [ItemFull] -> Speed
bspeed b activeItems =
case btrajectory b of
Nothing -> toSpeed $ max 1
$ sumSlotNoFilter IK.EqpSlotAddSpeed activeItems
Just (_, speed) -> speed
braced :: Actor -> Bool
braced = bwait
waitedLastTurn :: Actor -> Bool
waitedLastTurn = bwait
actorDying :: Actor -> Bool
actorDying b = bhp b <= 0
|| bproj b && maybe True (null . fst) (btrajectory b)
actorNewBorn :: Actor -> Bool
actorNewBorn b = isNothing (boldpos b)
&& not (waitedLastTurn b)
&& btime b >= timeTurn
hpTooLow :: Actor -> [ItemFull] -> Bool
hpTooLow b activeItems =
let maxHP = sumSlotNoFilter IK.EqpSlotAddMaxHP activeItems
in bhp b <= oneM || 5 * bhp b < xM maxHP && bhp b <= xM 10
hpHuge :: Actor -> Bool
hpHuge b = bhp b > xM 40
calmEnough :: Actor -> [ItemFull] -> Bool
calmEnough b activeItems =
let calmMax = max 1 $ sumSlotNoFilter IK.EqpSlotAddMaxCalm activeItems
in 2 * xM calmMax <= 3 * bcalm b
calmEnough10 :: Actor -> [ItemFull] -> Bool
calmEnough10 b activeItems = calmEnough b activeItems && bcalm b > xM 10
hpEnough :: Actor -> [ItemFull] -> Bool
hpEnough b activeItems =
let hpMax = max 1 $ sumSlotNoFilter IK.EqpSlotAddMaxHP activeItems
in xM hpMax <= 3 * bhp b
hpEnough10 :: Actor -> [ItemFull] -> Bool
hpEnough10 b activeItems = hpEnough b activeItems && bhp b > xM 10
unoccupied :: [Actor] -> Point -> Bool
unoccupied actors pos = all (\b -> bpos b /= pos) actors
smellTimeout :: Delta Time
smellTimeout = timeDeltaScale (Delta timeTurn) 100
type ActorDict = EM.EnumMap ActorId Actor
checkAdjacent :: Actor -> Actor -> Bool
checkAdjacent sb tb = blid sb == blid tb && adjacent (bpos sb) (bpos tb)
keySelected :: (ActorId, Actor) -> (Bool, Bool, Char, Color.Color, ActorId)
keySelected (aid, Actor{bsymbol, bcolor, bhp}) =
(bhp > 0, bsymbol /= '@', bsymbol, bcolor, aid)
ppContainer :: Container -> Text
ppContainer CFloor{} = "nearby"
ppContainer CEmbed{} = "embedded nearby"
ppContainer (CActor _ cstore) = ppCStoreIn cstore
ppContainer c@CTrunk{} = assert `failure` c
ppCStore :: CStore -> (Text, Text)
ppCStore CGround = ("on", "the ground")
ppCStore COrgan = ("among", "organs")
ppCStore CEqp = ("in", "equipment")
ppCStore CInv = ("in", "pack")
ppCStore CSha = ("in", "shared stash")
ppCStoreIn :: CStore -> Text
ppCStoreIn c = let (tIn, t) = ppCStore c in tIn <+> t
verbCStore :: CStore -> Text
verbCStore CGround = "drop"
verbCStore COrgan = "implant"
verbCStore CEqp = "equip"
verbCStore CInv = "pack"
verbCStore CSha = "stash"
instance Binary Actor where
put Actor{..} = do
put btrunk
put bsymbol
put bname
put bpronoun
put bcolor
put bhp
put bhpDelta
put bcalm
put bcalmDelta
put btrajectory
put bpos
put boldpos
put blid
put boldlid
put binv
put beqp
put borgan
put btime
put bwait
put bfid
put bfidImpressed
put bfidOriginal
put bproj
get = do
btrunk <- get
bsymbol <- get
bname <- get
bpronoun <- get
bcolor <- get
bhp <- get
bhpDelta <- get
bcalm <- get
bcalmDelta <- get
btrajectory <- get
bpos <- get
boldpos <- get
blid <- get
boldlid <- get
binv <- get
beqp <- get
borgan <- get
btime <- get
bwait <- get
bfid <- get
bfidImpressed <- get
bfidOriginal <- get
bproj <- get
return $! Actor{..}
instance Binary ResDelta where
put ResDelta{..} = do
put resCurrentTurn
put resPreviousTurn
get = do
resCurrentTurn <- get
resPreviousTurn <- get
return $! ResDelta{..}