{-# LANGUAGE RankNTypes #-}
-- | Running and disturbance.
--
-- The general rule is: whatever is behind you (and so ignored previously),
-- determines what you ignore moving forward. This is calcaulated
-- separately for the tiles to the left, to the right and in the middle
-- along the running direction. So, if you want to ignore something
-- start running when you stand on it (or to the right or left, respectively)
-- or by entering it (or passing to the right or left, respectively).
--
-- Some things are never ignored, such as: enemies seen, imporant messages
-- heard, solid tiles and actors in the way.
module Game.LambdaHack.Client.UI.RunM
  ( continueRun
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , continueRunDir, walkableDir, tryTurning, checkAndRun
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import           GHC.Exts (inline)

import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.Request
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Content.TileKind (TileKind)
import           Game.LambdaHack.Definition.Defs

-- | Continue running in the given direction.
continueRun :: MonadClientUI m
            => LevelId -> RunParams
            -> m (Either Text RequestTimed)
continueRun :: LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
paramOld = case RunParams
paramOld of
  RunParams{ runMembers :: RunParams -> [ActorId]
runMembers = []
           , runStopMsg :: RunParams -> Maybe Text
runStopMsg = Just Text
stopMsg } -> Either Text RequestTimed -> m (Either Text RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text RequestTimed -> m (Either Text RequestTimed))
-> Either Text RequestTimed -> m (Either Text RequestTimed)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text RequestTimed
forall a b. a -> Either a b
Left Text
stopMsg
  RunParams{ runMembers :: RunParams -> [ActorId]
runMembers = []
           , runStopMsg :: RunParams -> Maybe Text
runStopMsg = Maybe Text
Nothing } ->
    Either Text RequestTimed -> m (Either Text RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text RequestTimed -> m (Either Text RequestTimed))
-> Either Text RequestTimed -> m (Either Text RequestTimed)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text RequestTimed
forall a b. a -> Either a b
Left Text
"selected actors no longer there"
  RunParams{ ActorId
runLeader :: RunParams -> ActorId
runLeader :: ActorId
runLeader
           , runMembers :: RunParams -> [ActorId]
runMembers = ActorId
r : [ActorId]
rs
           , Bool
runInitial :: RunParams -> Bool
runInitial :: Bool
runInitial
           , Maybe Text
runStopMsg :: Maybe Text
runStopMsg :: RunParams -> Maybe Text
runStopMsg } -> do
    -- If runInitial and r == runLeader, it means the leader moves
    -- again, after all other members, in step 0,
    -- so we call continueRunDir with True to change direction once
    -- and then unset runInitial.
    let runInitialNew :: Bool
runInitialNew = Bool
runInitial Bool -> Bool -> Bool
&& ActorId
r ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
runLeader
        paramIni :: RunParams
paramIni = RunParams
paramOld {runInitial :: Bool
runInitial = Bool
runInitialNew}
    Bool
onLevel <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
r LevelId
arena
    Bool
onLevelLeader <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
runLeader LevelId
arena
    if | Bool -> Bool
not Bool
onLevel -> do
         let paramNew :: RunParams
paramNew = RunParams
paramIni {runMembers :: [ActorId]
runMembers = [ActorId]
rs }
         LevelId -> RunParams -> m (Either Text RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
paramNew
       | Bool -> Bool
not Bool
onLevelLeader -> do
         let paramNew :: RunParams
paramNew = RunParams
paramIni {runLeader :: ActorId
runLeader = ActorId
r}
         LevelId -> RunParams -> m (Either Text RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
paramNew
       | Bool
otherwise -> do
         Either Text Vector
mdirOrRunStopMsgCurrent <- RunParams -> m (Either Text Vector)
forall (m :: * -> *).
MonadClientUI m =>
RunParams -> m (Either Text Vector)
continueRunDir RunParams
paramOld
         let runStopMsgCurrent :: Maybe Text
runStopMsgCurrent =
               (Text -> Maybe Text)
-> (Vector -> Maybe Text) -> Either Text Vector -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Maybe Text
forall a. a -> Maybe a
Just (Maybe Text -> Vector -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Either Text Vector
mdirOrRunStopMsgCurrent
             runStopMsgNew :: Maybe Text
runStopMsgNew = Maybe Text
runStopMsg Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Text
runStopMsgCurrent
             -- We check @runStopMsgNew@, because even if the current actor
             -- runs OK, we want to stop soon if some others had to stop.
             runMembersNew :: [ActorId]
runMembersNew = if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
runStopMsgNew then [ActorId]
rs else [ActorId]
rs [ActorId] -> [ActorId] -> [ActorId]
forall a. [a] -> [a] -> [a]
++ [ActorId
r]
             paramNew :: RunParams
paramNew = RunParams
paramIni { runMembers :: [ActorId]
runMembers = [ActorId]
runMembersNew
                                 , runStopMsg :: Maybe Text
runStopMsg = Maybe Text
runStopMsgNew }
         case Either Text Vector
mdirOrRunStopMsgCurrent of
           Left Text
_ -> LevelId -> RunParams -> m (Either Text RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
paramNew
                       -- run all others undisturbed; one time
           Right Vector
dir -> do
             ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
updateClientLeader ActorId
r
             (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {srunning :: Maybe RunParams
srunning = RunParams -> Maybe RunParams
forall a. a -> Maybe a
Just RunParams
paramNew}
             Either Text RequestTimed -> m (Either Text RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text RequestTimed -> m (Either Text RequestTimed))
-> Either Text RequestTimed -> m (Either Text RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Either Text RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> Either Text RequestTimed)
-> RequestTimed -> Either Text RequestTimed
forall a b. (a -> b) -> a -> b
$ Vector -> RequestTimed
ReqMove Vector
dir
         -- The potential invisible actor is hit. War is started without asking.

-- | This function implements the actual logic of running. It checks if we
-- have to stop running because something interesting cropped up,
-- it ajusts the direction given by the vector if we reached
-- a corridor's corner (we never change direction except in corridors)
-- and it increments the counter of traversed tiles.
--
-- Note that while goto-xhair commands ignore items on the way,
-- here we stop wnenever we touch an item. Running is more cautious
-- to compensate that the player cannot specify the end-point of running.
-- It's also more suited to open, already explored terrain. Goto-xhair
-- works better with unknown terrain, e.g., it stops whenever an item
-- is spotted, but then ignores the item, leaving it to the player
-- to mark the item position as a goal of the next goto.
continueRunDir :: MonadClientUI m
               => RunParams -> m (Either Text Vector)
continueRunDir :: RunParams -> m (Either Text Vector)
continueRunDir RunParams
params = case RunParams
params of
  RunParams{ runMembers :: RunParams -> [ActorId]
runMembers = [] } -> [Char] -> m (Either Text Vector)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Either Text Vector))
-> [Char] -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> RunParams -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` RunParams
params
  RunParams{ ActorId
runLeader :: ActorId
runLeader :: RunParams -> ActorId
runLeader
           , runMembers :: RunParams -> [ActorId]
runMembers = ActorId
aid : [ActorId]
_
           , Bool
runInitial :: Bool
runInitial :: RunParams -> Bool
runInitial } -> do
    Report
report <- (SessionUI -> Report) -> m Report
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Report) -> m Report)
-> (SessionUI -> Report) -> m Report
forall a b. (a -> b) -> a -> b
$ History -> Report
newReport (History -> Report)
-> (SessionUI -> History) -> SessionUI -> Report
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> History
shistory
    let msgInterrupts :: Bool
msgInterrupts = (MsgClass -> Bool) -> Report -> Bool
anyInReport MsgClass -> Bool
interruptsRunning Report
report
    if Bool
msgInterrupts then Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"message shown"
    else do
      cops :: COps
cops@COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
      Actor
rbody <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
runLeader
      let rposHere :: Point
rposHere = Actor -> Point
bpos Actor
rbody
          rposLast :: Point
rposLast = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Point
forall a. HasCallStack => [Char] -> a
error ([Char] -> Point) -> [Char] -> Point
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
runLeader, Actor
rbody))
                               (Actor -> Maybe Point
boldpos Actor
rbody)
          -- Match run-leader dir, because we want runners to keep formation.
          dir :: Vector
dir = Point
rposHere Point -> Point -> Vector
`vectorToFrom` Point
rposLast
      Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      let lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
      Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
      let posHere :: Point
posHere = Actor -> Point
bpos Actor
body
          posThere :: Point
posThere = Point
posHere Point -> Vector -> Point
`shift` Vector
dir
          bigActorThere :: Bool
bigActorThere = Point -> Level -> Bool
occupiedBigLvl Point
posThere Level
lvl
          projsThere :: Bool
projsThere = Point -> Level -> Bool
occupiedProjLvl Point
posThere Level
lvl
      let openableLast :: Bool
openableLast =
            TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` (Point
posHere Point -> Vector -> Point
`shift` Vector
dir))
          check :: m (Either Text Vector)
check
            | Bool
bigActorThere = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"actor in the way"
            | Bool
projsThere = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"projectile in the way"
                -- don't displace actors, except with leader in step 0
            | COps -> Level -> Point -> Vector -> Bool
walkableDir COps
cops Level
lvl Point
posHere Vector
dir =
                if Bool
runInitial Bool -> Bool -> Bool
&& ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
runLeader
                then Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Vector -> Either Text Vector
forall a b. b -> Either a b
Right Vector
dir  -- zeroth step always OK
                else ActorId -> Vector -> m (Either Text Vector)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Vector -> m (Either Text Vector)
checkAndRun ActorId
aid Vector
dir
            | Bool -> Bool
not (Bool
runInitial Bool -> Bool -> Bool
&& ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
runLeader) = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"blocked"
                -- don't change direction, except in step 1 and by run-leader
            | Bool
openableLast = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"blocked by a closed door"
                -- the player may prefer to open the door
            | Bool
otherwise =
                -- Assume turning is permitted, because this is the start
                -- of the run, so the situation is mostly known to the player
                ActorId -> m (Either Text Vector)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Either Text Vector)
tryTurning ActorId
aid
      m (Either Text Vector)
check

walkableDir :: COps -> Level -> Point -> Vector -> Bool
walkableDir :: COps -> Level -> Point -> Vector -> Bool
walkableDir COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} Level
lvl Point
spos Vector
dir =
  TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` (Point
spos Point -> Vector -> Point
`shift` Vector
dir)

tryTurning :: MonadClientRead m
           => ActorId -> m (Either Text Vector)
tryTurning :: ActorId -> m (Either Text Vector)
tryTurning ActorId
aid = do
  cops :: COps
cops@COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  let lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  let posHere :: Point
posHere = Actor -> Point
bpos Actor
body
      posLast :: Point
posLast = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Point
forall a. HasCallStack => [Char] -> a
error ([Char] -> Point) -> [Char] -> Point
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Actor
body)) (Actor -> Maybe Point
boldpos Actor
body)
      dirLast :: Vector
dirLast = Point
posHere Point -> Point -> Vector
`vectorToFrom` Point
posLast
  let openableDir :: Vector -> Bool
openableDir Vector
dir =
        TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` (Point
posHere Point -> Vector -> Point
`shift` Vector
dir))
      dirWalkable :: Vector -> Bool
dirWalkable Vector
dir = COps -> Level -> Point -> Vector -> Bool
walkableDir COps
cops Level
lvl Point
posHere Vector
dir Bool -> Bool -> Bool
|| Vector -> Bool
openableDir Vector
dir
      dirNearby :: Vector -> Vector -> Bool
dirNearby Vector
dir1 Vector
dir2 = Vector -> Vector -> Int
euclidDistSqVector Vector
dir1 Vector
dir2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      -- Distance 2 could be useful, but surprising even to apt players.
      dirSimilar :: Vector -> Bool
dirSimilar Vector
dir = Vector -> Vector -> Bool
dirNearby Vector
dirLast Vector
dir Bool -> Bool -> Bool
&& Vector -> Bool
dirWalkable Vector
dir
      dirsSimilar :: [Vector]
dirsSimilar = (Vector -> Bool) -> [Vector] -> [Vector]
forall a. (a -> Bool) -> [a] -> [a]
filter Vector -> Bool
dirSimilar [Vector]
moves
  case [Vector]
dirsSimilar of
    [] -> Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"dead end"
    Vector
d1 : [Vector]
ds | (Vector -> Bool) -> [Vector] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Vector -> Vector -> Bool
dirNearby Vector
d1) [Vector]
ds ->  -- only one or two directions possible
      case (Vector -> Int) -> [Vector] -> [Vector]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Vector -> Vector -> Int
euclidDistSqVector Vector
dirLast)
           ([Vector] -> [Vector]) -> [Vector] -> [Vector]
forall a b. (a -> b) -> a -> b
$ (Vector -> Bool) -> [Vector] -> [Vector]
forall a. (a -> Bool) -> [a] -> [a]
filter (COps -> Level -> Point -> Vector -> Bool
walkableDir COps
cops Level
lvl Point
posHere) ([Vector] -> [Vector]) -> [Vector] -> [Vector]
forall a b. (a -> b) -> a -> b
$ Vector
d1 Vector -> [Vector] -> [Vector]
forall a. a -> [a] -> [a]
: [Vector]
ds of
        [] ->
          Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"blocked and all similar directions are non-walkable"
        Vector
d : [Vector]
_ -> ActorId -> Vector -> m (Either Text Vector)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Vector -> m (Either Text Vector)
checkAndRun ActorId
aid Vector
d
    [Vector]
_ -> Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"blocked and many distant similar directions found"

-- The direction is different than the original, if called from @tryTurning@
-- and the same if from @continueRunDir@.
checkAndRun :: MonadClientRead m
            => ActorId -> Vector -> m (Either Text Vector)
checkAndRun :: ActorId -> Vector -> m (Either Text Vector)
checkAndRun ActorId
aid Vector
dir = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  Int
smarkSuspect <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
smarkSuspect
  let lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  ActorDict
actorD <- (State -> ActorDict) -> m ActorDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorDict
sactorD
  let posHere :: Point
posHere = Actor -> Point
bpos Actor
body
      posHasItems :: Point -> Bool
posHasItems Point
pos = Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member Point
pos (EnumMap Point ItemBag -> Bool) -> EnumMap Point ItemBag -> Bool
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ItemBag
lfloor Level
lvl
      posThere :: Point
posThere = Point
posHere Point -> Vector -> Point
`shift` Vector
dir
      bigActorThere :: Bool
bigActorThere = Point -> Level -> Bool
occupiedBigLvl Point
posThere Level
lvl
      enemyThreatensThere :: Bool
enemyThreatensThere =
        let f :: Point -> Bool
f !Point
p = case Point -> Level -> Maybe ActorId
posToBigLvl Point
p Level
lvl of
                Maybe ActorId
Nothing -> Bool
False
                Just ActorId
aid2 -> ActorId -> Actor -> Bool
g ActorId
aid2 (Actor -> Bool) -> Actor -> Bool
forall a b. (a -> b) -> a -> b
$ ActorDict
actorD ActorDict -> ActorId -> Actor
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid2
            g :: ActorId -> Actor -> Bool
g ActorId
aid2 !Actor
b2 = (FactionId -> Faction -> FactionId -> Bool)
-> FactionId -> Faction -> FactionId -> Bool
forall a. a -> a
inline FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact (Actor -> FactionId
bfid Actor
b2)
                         Bool -> Bool -> Bool
&& ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMeleeToHarm ActorMaxSkills
actorMaxSkills ActorId
aid2 Actor
b2
                         Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0  -- uncommon
        in (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Point -> Bool
f ([Point] -> Bool) -> [Point] -> Bool
forall a b. (a -> b) -> a -> b
$ Point -> [Point]
vicinityUnsafe Point
posThere
      projsThere :: Bool
projsThere = Point -> Level -> Bool
occupiedProjLvl Point
posThere Level
lvl
  let posLast :: Point
posLast = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Point
forall a. HasCallStack => [Char] -> a
error ([Char] -> Point) -> [Char] -> Point
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Actor
body)) (Actor -> Maybe Point
boldpos Actor
body)
      dirLast :: Vector
dirLast = Point
posHere Point -> Point -> Vector
`vectorToFrom` Point
posLast
      -- This is supposed to work on unit vectors --- diagonal, as well as,
      -- vertical and horizontal.
      anglePos :: Point -> Vector -> RadianAngle -> Point
      anglePos :: Point -> Vector -> RadianAngle -> Point
anglePos Point
pos Vector
d RadianAngle
angle = Point -> Vector -> Point
shift Point
pos (RadianAngle -> Vector -> Vector
rotate RadianAngle
angle Vector
d)
      -- We assume the tiles have not changed since last running step.
      -- If they did, we don't care --- running should be stopped
      -- because of the change of nearby tiles then.
      -- We don't take into account the two tiles at the rear of last
      -- surroundings, because the actor may have come from there
      -- (via a diagonal move) and if so, he may be interested in such tiles.
      -- If he arrived directly from the right or left, he is responsible
      -- for starting the run further away, if he does not want to ignore
      -- such tiles as the ones he came from.
      tileLast :: ContentId TileKind
tileLast = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
posLast
      tileHere :: ContentId TileKind
tileHere = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
posHere
      tileThere :: ContentId TileKind
tileThere = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
posThere
      leftPsLast :: [Point]
leftPsLast = (RadianAngle -> Point) -> [RadianAngle] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dirLast) [RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
2, RadianAngle
3RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
*RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4]
                   [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ (RadianAngle -> Point) -> [RadianAngle] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dir) [RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
2, RadianAngle
3RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
*RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4]
      rightPsLast :: [Point]
rightPsLast = (RadianAngle -> Point) -> [RadianAngle] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dirLast) [-RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
2, -RadianAngle
3RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
*RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4]
                    [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ (RadianAngle -> Point) -> [RadianAngle] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dir) [-RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
2, -RadianAngle
3RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
*RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4]
      leftForwardPosHere :: Point
leftForwardPosHere = Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dir (RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4)
      rightForwardPosHere :: Point
rightForwardPosHere = Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dir (-RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4)
      leftTilesLast :: [ContentId TileKind]
leftTilesLast = (Point -> ContentId TileKind) -> [Point] -> [ContentId TileKind]
forall a b. (a -> b) -> [a] -> [b]
map (Level
lvl Level -> Point -> ContentId TileKind
`at`) [Point]
leftPsLast
      rightTilesLast :: [ContentId TileKind]
rightTilesLast = (Point -> ContentId TileKind) -> [Point] -> [ContentId TileKind]
forall a b. (a -> b) -> [a] -> [b]
map (Level
lvl Level -> Point -> ContentId TileKind
`at`) [Point]
rightPsLast
      leftForwardTileHere :: ContentId TileKind
leftForwardTileHere = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
leftForwardPosHere
      rightForwardTileHere :: ContentId TileKind
rightForwardTileHere = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
rightForwardPosHere
      tilePropAt :: ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
      tilePropAt :: ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt ContentId TileKind
tile =
        let suspect :: Bool
suspect =
              Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
tile
              Bool -> Bool -> Bool
|| Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideAs TileSpeedup
coTileSpeedup ContentId TileKind
tile
            embed :: Bool
embed = TileSpeedup -> ContentId TileKind -> Bool
Tile.isEmbed TileSpeedup
coTileSpeedup ContentId TileKind
tile  -- no matter if embeds left
            walkable :: Bool
walkable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
tile
            openable :: Bool
openable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup ContentId TileKind
tile
            closable :: Bool
closable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isClosable TileSpeedup
coTileSpeedup ContentId TileKind
tile
            modifiable :: Bool
modifiable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
tile
        in (Bool
suspect, Bool
embed, Bool
walkable, Bool
openable, Bool
closable, Bool
modifiable)
      terrainChangeMiddle :: Bool
terrainChangeMiddle = ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt ContentId TileKind
tileThere
                            (Bool, Bool, Bool, Bool, Bool, Bool)
-> [(Bool, Bool, Bool, Bool, Bool, Bool)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool))
-> [ContentId TileKind] -> [(Bool, Bool, Bool, Bool, Bool, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt [ContentId TileKind
tileLast, ContentId TileKind
tileHere]
      terrainChangeLeft :: Bool
terrainChangeLeft = ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt ContentId TileKind
leftForwardTileHere
                          (Bool, Bool, Bool, Bool, Bool, Bool)
-> [(Bool, Bool, Bool, Bool, Bool, Bool)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool))
-> [ContentId TileKind] -> [(Bool, Bool, Bool, Bool, Bool, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt [ContentId TileKind]
leftTilesLast
      terrainChangeRight :: Bool
terrainChangeRight = ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt ContentId TileKind
rightForwardTileHere
                           (Bool, Bool, Bool, Bool, Bool, Bool)
-> [(Bool, Bool, Bool, Bool, Bool, Bool)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool))
-> [ContentId TileKind] -> [(Bool, Bool, Bool, Bool, Bool, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt [ContentId TileKind]
rightTilesLast
      itemChangeLeft :: Bool
itemChangeLeft = Point -> Bool
posHasItems Point
leftForwardPosHere
                       Bool -> [Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Point -> Bool) -> [Point] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Point -> Bool
posHasItems [Point]
leftPsLast
      itemChangeRight :: Bool
itemChangeRight = Point -> Bool
posHasItems Point
rightForwardPosHere
                        Bool -> [Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Point -> Bool) -> [Point] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Point -> Bool
posHasItems [Point]
rightPsLast
      check :: m (Either Text Vector)
check
        | Bool
bigActorThere = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"actor in the way"
        | Bool
enemyThreatensThere = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"enemy threatens the position"
        | Bool
projsThere = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"projectile in the way"
            -- Actor in possibly another direction tnan original.
            -- (e.g., called from @tryTurning@).
        | Bool
terrainChangeLeft = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"terrain change on the left"
        | Bool
terrainChangeRight = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"terrain change on the right"
        | Bool
itemChangeLeft = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"item change on the left"
        | Bool
itemChangeRight = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"item change on the right"
        | Bool
terrainChangeMiddle = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"terrain change in the middle"
        | Bool
otherwise = Either Text Vector -> m (Either Text Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Vector -> Either Text Vector
forall a b. b -> Either a b
Right Vector
dir
  m (Either Text Vector)
check