module Game.LambdaHack.Client.RunAction
( continueRunDir
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.List as L
import Data.Maybe
import Control.Exception.Assert.Sugar
import Game.LambdaHack.Client.Action
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Action
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.Feature as F
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.PointXY
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.TileKind
canRun :: MonadClient m => ActorId -> (Vector, Int) -> m Bool
canRun leader (dir, dist) = do
cops <- getsState scops
b <- getsState $ getActorBody leader
lvl <- getLevel $ blid b
stgtMode <- getsClient stgtMode
assert (isNothing stgtMode `blame` "attempt to run in target mode"
`twith` (dir, dist, stgtMode)) skip
return $ accessibleDir cops lvl (bpos b) dir
runDir :: MonadClient m => ActorId -> (Vector, Int) -> m (Vector, Int)
runDir leader (dir, dist) = do
canR <- canRun leader (dir, dist)
let
distNew = if canR then dist + 1 else dist
return (dir, distNew)
data RunMode =
RunOpen
| RunHub
| RunCorridor !(Vector, Bool)
| RunDeadEnd
runMode :: Point -> Vector -> (Point -> Vector -> Bool) -> X -> RunMode
runMode pos dir dirEnterable lxsize =
let dirNearby dir1 dir2 = euclidDistSq lxsize dir1 dir2 == 1
dirBackward d = euclidDistSq lxsize (neg dir) d <= 1
dirAhead d = euclidDistSq lxsize dir d <= 2
findOpen =
let f dirC open = open ++
case L.filter (dirNearby dirC) dirsEnterable of
l | dirBackward dirC -> dirC : l
[] -> []
[_] -> []
l -> dirC : l
in L.foldr f []
dirsEnterable = L.filter (dirEnterable pos) (moves lxsize)
in case dirsEnterable of
[] -> assert `failure` "actor is stuck" `twith` (pos, dir)
[negdir] -> assert (negdir == neg dir) RunDeadEnd
_ ->
let dirsOpen = findOpen dirsEnterable
dirsCorridor = dirsEnterable L.\\ dirsOpen
in case dirsCorridor of
[] -> RunOpen
_ | L.any dirAhead dirsOpen -> RunOpen
[d] -> RunCorridor (d, False)
[d1, d2] | dirNearby d1 d2 ->
RunCorridor (if diagonal lxsize d1 then d2 else d1, True)
_ -> RunHub
runDisturbance :: Point -> Int -> Report
-> [Actor] -> [Actor] -> Perception -> Bool -> Point
-> (F.Feature -> Point -> Bool) -> (Point -> Bool)
-> Kind.Ops TileKind -> Level -> X -> Y
-> (Vector, Int) -> Maybe (Vector, Int)
runDisturbance posLast distLast report hs ms per markSuspect posHere
posHasFeature posHasItems
cotile lvl lxsize lysize (dirNew, distNew) =
let boringMsgs = map BS.pack [ "You hear some noises." ]
msgShown = isJust $ findInReport (`notElem` boringMsgs) report
msposs = ES.delete posHere $ ES.fromList (L.map bpos ms)
enemySeen =
not (ES.null (msposs `ES.intersection` totalVisible per))
surrLast = posLast : vicinity lxsize lysize posLast
surrHere = posHere : vicinity lxsize lysize posHere
posThere = posHere `shift` dirNew
heroThere = posThere `elem` L.map bpos hs
touchList = [ posHasFeature F.Exit
, posHasItems
]
standList = [ posHasFeature F.Path
]
firstList = [ posHasFeature F.Lit
, not . posHasFeature F.Lit
, not . posHasFeature F.Path
, \t -> markSuspect && posHasFeature F.Suspect t
]
touchNew fun =
let touchLast = L.filter fun surrLast
touchHere = L.filter fun surrHere
in touchHere L.\\ touchLast
touchExplore fun = touchNew fun == [posThere]
touchStop fun = touchNew fun /= []
standNew fun = L.filter (\pos -> posHasFeature F.Walkable pos ||
Tile.openable cotile (lvl `at` pos))
(touchNew fun)
standExplore fun = not (fun posHere) && standNew fun == [posThere]
standStop fun = not (fun posHere) && standNew fun /= []
firstNew fun = L.all (not . fun) surrLast &&
L.any fun surrHere
firstExplore fun = firstNew fun && fun posThere
firstStop = firstNew
tryRunMaybe
| msgShown || enemySeen
|| heroThere || distLast >= 40 = Nothing
| L.any touchExplore touchList = Just (dirNew, 1000)
| L.any standExplore standList = Just (dirNew, 1000)
| L.any firstExplore firstList = Just (dirNew, 1000)
| L.any touchStop touchList = Nothing
| L.any standStop standList = Nothing
| L.any firstStop firstList = Nothing
| otherwise = Just (dirNew, distNew)
in tryRunMaybe
continueRunDir :: MonadClientAbort m
=> ActorId -> (Vector, Int)
-> m (Vector, Int)
continueRunDir leader (dirLast, distLast) = do
cops@Kind.COps{cotile} <- getsState scops
body <- getsState $ getActorBody leader
let lid = blid body
per <- getPerFid lid
sreport <- getsClient sreport
smarkSuspect <- getsClient smarkSuspect
fact <- getsState $ (EM.! bfid body) . sfactionD
ms <- getsState $ actorList (isAtWar fact) lid
hs <- getsState $ actorList (not . isAtWar fact) lid
lvl@Level{lxsize, lysize} <- getLevel $ blid body
let posHere = bpos body
posHasFeature f pos = Tile.hasFeature cotile f (lvl `at` pos)
posHasItems pos = not $ EM.null $ lvl `atI` pos
posLast = if distLast == 0 then posHere else posHere `shift` neg dirLast
tryRunDist (dir, distNew)
| accessibleDir cops lvl posHere dir =
maybe abort (runDir leader) $
runDisturbance
posLast distLast sreport hs ms per smarkSuspect posHere
posHasFeature posHasItems cotile lvl lxsize lysize (dir, distNew)
| otherwise = abort
tryRun dir = tryRunDist (dir, distLast)
_tryRunAndStop dir = tryRunDist (dir, 1000)
openableDir pos dir = Tile.openable cotile (lvl `at` (pos `shift` dir))
dirEnterable pos d = accessibleDir cops lvl pos d || openableDir pos d
case runMode posHere dirLast dirEnterable lxsize of
RunDeadEnd -> abort
RunOpen -> tryRun dirLast
RunHub -> abort
RunCorridor (dirNext, _turn) ->
tryRun dirNext