module Game.LambdaHack.Client.CommonClient
( getPerFid, aidTgtToPos, aidTgtAims, makeLine
, partAidLeader, partActorLeader, partPronounLeader
, actorSkillsClient, 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.Common.Effect as Effect
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 -> Maybe ActorId -> m Ability.Skills
actorSkillsClient aid mleader = do
activeItems <- activeItemsClient aid
getsState $ actorSkills aid mleader 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
disco <- getsClient sdisco
discoAE <- getsClient sdiscoAE
getsState $ fullAssocs cops disco discoAE 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 -> Int -> ItemFull)
itemToFullClient = do
cops <- getsState scops
disco <- getsClient sdisco
discoAE <- getsClient sdiscoAE
s <- getState
let itemToF iid = itemToFull cops disco discoAE 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]
mleader <- getsClient _sleader
actorSk <- actorSkillsClient source mleader
let allAssocs = eqpAssocs ++ bodyAssocs
case filter (not . unknownPrecious . snd . snd)
$ strongestSlotNoFilter Effect.EqpSlotWeapon allAssocs 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
=> Effect.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