module Game.LambdaHack.Common.Actor
(
ActorId, monsterGenChance, partActor, partPronoun
, Actor(..), ResDelta(..)
, deltaSerious, deltaMild, xM, minusM, minusTwoM, oneM
, bspeed, actorTemplate, timeShiftFromSpeed, braced, waitedLastTurn
, actorDying, actorNewBorn, hpTooLow, unoccupied
, ActorDict, smellTimeout, checkAdjacent
, mapActorItems_, ppCStore, ppContainer
) where
import Control.Exception.Assert.Sugar
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import Data.Int (Int64)
import Data.Ratio
import Data.Text (Text)
import qualified NLP.Miniutter.English as MU
import qualified Game.LambdaHack.Common.Color as Color
import qualified Game.LambdaHack.Common.Effect as Effect
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemStrongest
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
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 :: !Point
, blid :: !LevelId
, boldlid :: !LevelId
, bfid :: !FactionId
, boldfid :: !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 (AbsDepth n) (AbsDepth depth) numMonsters actorCoeff =
assert (depth > 0)
$ let scaledDepth = 5 * n `div` depth
in chance $ 1%(fromIntegral
$ (10 * actorCoeff * (numMonsters scaledDepth))
`max` actorCoeff)
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 = Point 0 0
boldlid = blid
beqp = EM.empty
binv = EM.empty
borgan = EM.empty
bwait = False
boldfid = 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 Effect.EqpSlotAddSpeed activeItems
Just (_, speed) -> speed
timeShiftFromSpeed :: Actor -> [ItemFull] -> Time -> Time
timeShiftFromSpeed b activeItems time =
let speed = bspeed b activeItems
delta = ticksPerMeter speed
in timeShift time delta
braced :: Actor -> Bool
braced b = bwait b
waitedLastTurn :: Actor -> Bool
waitedLastTurn b = bwait b
actorDying :: Actor -> Bool
actorDying b = if bproj b
then bhp b < 0
|| maybe True (null . fst) (btrajectory b)
else bhp b <= 0
actorNewBorn :: Actor -> Bool
actorNewBorn b = boldpos b == Point 0 0
&& not (waitedLastTurn b)
&& not (btime b < timeTurn)
hpTooLow :: Actor -> [ItemFull] -> Bool
hpTooLow b activeItems =
let maxHP = sumSlotNoFilter Effect.EqpSlotAddMaxHP activeItems
in bhp b <= oneM || 5 * bhp b < xM maxHP
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)
mapActorItems_ :: Monad m => (ItemId -> Int -> m a) -> Actor -> m ()
mapActorItems_ f Actor{binv, beqp, borgan} = do
let is = EM.assocs beqp ++ EM.assocs binv ++ EM.assocs borgan
mapM_ (uncurry f) is
ppCStore :: CStore -> Text
ppCStore CGround = "on the ground"
ppCStore COrgan = "among organs"
ppCStore CEqp = "in equipment"
ppCStore CInv = "in inventory"
ppCStore CSha = "in shared stash"
ppContainer :: Container -> Text
ppContainer CFloor{} = "nearby"
ppContainer (CActor _ cstore) = ppCStore cstore
ppContainer CTrunk{} = "in our possession"
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 boldfid
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
boldfid <- get
bproj <- get
return $! Actor{..}
instance Binary ResDelta where
put ResDelta{..} = do
put resCurrentTurn
put resPreviousTurn
get = do
resCurrentTurn <- get
resPreviousTurn <- get
return $! ResDelta{..}