module Game.LambdaHack.Client.CommonClient
( getPerFid, aidTgtToPos, aidTgtAims, makeLine
, partAidLeader, partActorLeader, partPronounLeader
, actorSkillsClient, maxActorSkillsClient
, updateItemSlot, fullAssocsClient, activeItemsClient
, itemToFullClient, pickWeaponClient, sumOrganEqpClient, getModeClient
) where
import Control.Exception.Assert.Sugar
import qualified Data.EnumMap.Strict as EM
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Data.Text (Text)
import Data.Tuple
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Client.ItemSlot
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import qualified Game.LambdaHack.Common.Ability as Ability
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemStrongest
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.Request
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.ModeKind
getPerFid :: MonadClient m => LevelId -> m Perception
getPerFid lid = do
fper <- getsClient sfper
return $! fromMaybe (assert `failure` "no perception at given level"
`twith` (lid, fper))
$ EM.lookup lid fper
partActorLeader :: MonadClient m => ActorId -> Actor -> m MU.Part
partActorLeader aid b = do
mleader <- getsClient _sleader
return $! case mleader of
Just leader | aid == leader -> "you"
_ -> partActor b
partPronounLeader :: MonadClient m => ActorId -> Actor -> m MU.Part
partPronounLeader aid b = do
mleader <- getsClient _sleader
return $! case mleader of
Just leader | aid == leader -> "you"
_ -> partPronoun b
partAidLeader :: MonadClient m => ActorId -> m MU.Part
partAidLeader aid = do
b <- getsState $ getActorBody aid
partActorLeader aid b
aidTgtToPos :: MonadClient m
=> ActorId -> LevelId -> Maybe Target -> m (Maybe Point)
aidTgtToPos aid lidV tgt =
case tgt of
Just (TEnemy a _) -> do
body <- getsState $ getActorBody a
return $! if blid body == lidV
then Just (bpos body)
else Nothing
Just (TEnemyPos _ lid p _) ->
return $! if lid == lidV then Just p else Nothing
Just (TPoint lid p) ->
return $! if lid == lidV then Just p else Nothing
Just (TVector v) -> do
b <- getsState $ getActorBody aid
Level{lxsize, lysize} <- getLevel lidV
let shifted = shiftBounded lxsize lysize (bpos b) v
return $! if shifted == bpos b && v /= Vector 0 0
then Nothing
else Just shifted
Nothing -> do
scursor <- getsClient scursor
aidTgtToPos aid lidV $ Just scursor
aidTgtAims :: MonadClient m
=> ActorId -> LevelId -> Maybe Target -> m (Either Text Int)
aidTgtAims aid lidV tgt = do
oldEps <- getsClient seps
case tgt of
Just (TEnemy a _) -> do
body <- getsState $ getActorBody a
let pos = bpos body
b <- getsState $ getActorBody aid
if blid b == lidV then do
mnewEps <- makeLine b pos oldEps
case mnewEps of
Just newEps -> return $ Right newEps
Nothing -> return $ Left "aiming line to the opponent blocked"
else return $ Left "target opponent not on this level"
Just TEnemyPos{} -> return $ Left "target opponent not visible"
Just TPoint{} -> return $ Right oldEps
Just TVector{} -> return $ Right oldEps
Nothing -> do
scursor <- getsClient scursor
aidTgtAims aid lidV $ Just scursor
makeLine :: MonadClient m => Actor -> Point -> Int -> m (Maybe Int)
makeLine body fpos epsOld = do
cops@Kind.COps{cotile=Kind.Ops{ouniqGroup}} <- getsState scops
lvl@Level{lxsize, lysize} <- getLevel (blid body)
bs <- getsState $ filter (not . bproj)
. actorList (const True) (blid body)
let unknownId = ouniqGroup "unknown space"
dist = chessDist (bpos body) fpos
calcScore eps = case bla lxsize lysize eps (bpos body) fpos of
Just bl ->
let blDist = take dist bl
blZip = zip (bpos body : blDist) blDist
noActor p = all ((/= p) . bpos) bs || p == fpos
accessU = all noActor blDist
&& all (uncurry $ accessibleUnknown cops lvl) blZip
nUnknown = length $ filter ((== unknownId) . (lvl `at`)) blDist
in if accessU then nUnknown else minBound
Nothing -> assert `failure` (body, fpos, epsOld)
tryLines curEps (acc, _) | curEps >= epsOld + dist = acc
tryLines curEps (acc, bestScore) =
let curScore = calcScore curEps
newAcc = if curScore > bestScore
then (Just curEps, curScore)
else (acc, bestScore)
in tryLines (curEps + 1) newAcc
return $! if dist <= 1
then Nothing
else tryLines epsOld (Nothing, minBound)
actorSkillsClient :: MonadClient m => ActorId -> m Ability.Skills
actorSkillsClient aid = do
activeItems <- activeItemsClient aid
mleader <- getsClient _sleader
getsState $ actorSkills mleader aid activeItems
maxActorSkillsClient :: MonadClient m
=> ActorId -> m Ability.Skills
maxActorSkillsClient aid = do
activeItems <- activeItemsClient aid
getsState $ maxActorSkills aid activeItems
updateItemSlot :: MonadClient m => Maybe ActorId -> ItemId -> m ()
updateItemSlot maid iid = do
slots@(letterSlots, numberSlots) <- getsClient sslots
case ( lookup iid $ map swap $ EM.assocs letterSlots
, lookup iid $ map swap $ IM.assocs numberSlots ) of
(Nothing, Nothing) -> do
side <- getsClient sside
item <- getsState $ getItemBody iid
lastSlot <- getsClient slastSlot
mb <- maybe (return Nothing) (fmap Just . getsState . getActorBody) maid
el <- getsState $ assignSlot item side mb slots lastSlot
case el of
Left l ->
modifyClient $ \cli ->
cli { sslots = (EM.insert l iid letterSlots, numberSlots)
, slastSlot = max l (slastSlot cli) }
Right l ->
modifyClient $ \cli ->
cli { sslots = (letterSlots, IM.insert l iid numberSlots) }
_ -> return ()
fullAssocsClient :: MonadClient m
=> ActorId -> [CStore] -> m [(ItemId, ItemFull)]
fullAssocsClient aid cstores = do
cops <- getsState scops
discoKind <- getsClient sdiscoKind
discoEffect <- getsClient sdiscoEffect
getsState $ fullAssocs cops discoKind discoEffect aid cstores
activeItemsClient :: MonadClient m => ActorId -> m [ItemFull]
activeItemsClient aid = do
activeAssocs <- fullAssocsClient aid [CEqp, COrgan]
return $! map snd activeAssocs
itemToFullClient :: MonadClient m => m (ItemId -> ItemQuant -> ItemFull)
itemToFullClient = do
cops <- getsState scops
discoKind <- getsClient sdiscoKind
discoEffect <- getsClient sdiscoEffect
s <- getState
let itemToF iid = itemToFull cops discoKind discoEffect iid
(getItemBody iid s)
return itemToF
pickWeaponClient :: MonadClient m
=> ActorId -> ActorId -> m [RequestTimed Ability.AbMelee]
pickWeaponClient source target = do
eqpAssocs <- fullAssocsClient source [CEqp]
bodyAssocs <- fullAssocsClient source [COrgan]
actorSk <- actorSkillsClient source
sb <- getsState $ getActorBody source
let allAssocs = eqpAssocs ++ bodyAssocs
calm10 = calmEnough10 sb $ map snd allAssocs
forced = assert (not $ bproj sb) False
legalPrecious = either (const False) id . permittedPrecious calm10 forced
strongest = strongestSlotNoFilter IK.EqpSlotWeapon allAssocs
strongestLegal = filter (legalPrecious . snd . snd) strongest
case strongestLegal of
_ | EM.findWithDefault 0 Ability.AbMelee actorSk <= 0 -> return []
[] -> return []
iis@((maxS, _) : _) -> do
let maxIis = map snd $ takeWhile ((== maxS) . fst) iis
(iid, _) <- rndToAction $ oneOf maxIis
let cstore = if isJust (lookup iid bodyAssocs) then COrgan else CEqp
return $! [ReqMelee target iid cstore]
sumOrganEqpClient :: MonadClient m
=> IK.EqpSlot -> ActorId -> m Int
sumOrganEqpClient eqpSlot aid = do
activeItems <- activeItemsClient aid
return $! sumSlotNoFilter eqpSlot activeItems
getModeClient :: MonadClient m => m ModeKind
getModeClient = do
Kind.COps{comode=Kind.Ops{okind, ouniqGroup}} <- getsState scops
t <- getsClient sgameMode
return $! okind $ ouniqGroup t