    {-# 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 :: forall (m :: * -> *).
    MonadClientUI m =>
    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 a. a -> m a
    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 a. a -> m a
    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 :: ActorId
    runLeader :: RunParams -> ActorId
    runLeader
               , runMembers :: RunParams -> [ActorId]
    runMembers = ActorId
    r : [ActorId]
    rs
               , Bool
    runInitial :: Bool
    runInitial :: RunParams -> Bool
    runInitial
               , Maybe Text
    runStopMsg :: RunParams -> Maybe Text
    runStopMsg :: 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 = runInitialNew}
        onLevel <- (State -> Bool) -> m Bool
    forall a. (State -> a) -> m a
    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
        onLevelLeader <- getsState $ memActor runLeader arena
        if | not onLevel -> do
             let paramNew = RunParams
    paramIni {runMembers = rs }
             continueRun arena paramNew
           | not onLevelLeader -> do
             let paramNew = RunParams
    paramIni {runLeader = r}
             continueRun arena paramNew
           | otherwise -> do
             mdirOrRunStopMsgCurrent <- continueRunDir paramOld
             let 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
    runStopMsg Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    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 = 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
    paramIni { runMembers = runMembersNew
                                     , runStopMsg = runStopMsgNew }
             case 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 = Just paramNew}
                 Either Text RequestTimed -> m (Either Text RequestTimed)
    forall a. a -> m a
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    RunParams -> m (Either Text Vector)
    continueRunDir RunParams
    params = case RunParams
    params of
      RunParams{ runMembers :: RunParams -> [ActorId]
    runMembers = [] } -> String -> m (Either Text Vector)
    forall a. HasCallStack => String -> a
    error (String -> m (Either Text Vector))
    -> String -> m (Either Text Vector)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> RunParams -> String
    forall v. Show v => String -> v -> String
    `showFailure` RunParams
    params
      RunParams{ ActorId
    runLeader :: RunParams -> ActorId
    runLeader :: ActorId
    runLeader
               , runMembers :: RunParams -> [ActorId]
    runMembers = ActorId
    aid : [ActorId]
    _
               , Bool
    runInitial :: RunParams -> Bool
    runInitial :: Bool
    runInitial } -> do
        report <- (SessionUI -> Report) -> m Report
    forall a. (SessionUI -> a) -> m a
    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 = (MsgClass -> Bool) -> Report -> Bool
    anyInReport MsgClass -> Bool
    interruptsRunning Report
    report
        if msgInterrupts then return $ Left "message shown"
        else do
          cops@COps{coTileSpeedup} <- getsState scops
          rbody <- getsState $ getActorBody runLeader
          let rposHere = Actor -> Point
    bpos Actor
    rbody
              rposLast = Point -> Maybe Point -> Point
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Point
    forall a. HasCallStack => String -> a
    error (String -> Point) -> String -> Point
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    runLeader, Actor
    rbody))
                                   (Actor -> Maybe Point
    boldpos Actor
    rbody)
              -- Match run-leader dir, because we want runners to keep formation.
              dir = Point
    rposHere Point -> Point -> Vector
    `vectorToFrom` Point
    rposLast
          body <- getsState $ getActorBody aid
          let lid = Actor -> LevelId
    blid Actor
    body
          lvl <- getLevel lid
          let posHere = Actor -> Point
    bpos Actor
    body
              posThere = Point
    posHere Point -> Vector -> Point
    `shift` Vector
    dir
              bigActorThere = Point -> Level -> Bool
    occupiedBigLvl Point
    posThere Level
    lvl
              projsThere = Point -> Level -> Bool
    occupiedProjLvl Point
    posThere Level
    lvl
          let 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
                | Bool
    bigActorThere = Either Text Vector -> m (Either Text Vector)
    forall a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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
          check

    walkableDir :: COps -> Level -> Point -> Vector -> Bool
    walkableDir :: COps -> Level -> Point -> Vector -> Bool
    walkableDir COps{TileSpeedup
    coTileSpeedup :: COps -> TileSpeedup
    coTileSpeedup :: 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 :: forall (m :: * -> *).
    MonadClientRead m =>
    ActorId -> m (Either Text Vector)
    tryTurning ActorId
    aid = do
      cops@COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      body <- getsState $ getActorBody aid
      let lid = Actor -> LevelId
    blid Actor
    body
      lvl <- getLevel lid
      let posHere = Actor -> Point
    bpos Actor
    body
          posLast = Point -> Maybe Point -> Point
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Point
    forall a. HasCallStack => String -> a
    error (String -> Point) -> String -> Point
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    body)) (Actor -> Maybe Point
    boldpos Actor
    body)
          dirLast = Point
    posHere Point -> Point -> Vector
    `vectorToFrom` Point
    posLast
      let 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
    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
    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
    dir = Vector -> Vector -> Bool
    dirNearby Vector
    dirLast Vector
    dir Bool -> Bool -> Bool
    && Vector -> Bool
    dirWalkable Vector
    dir
          dirsSimilar = (Vector -> Bool) -> [Vector] -> [Vector]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Vector -> Bool
    dirSimilar [Vector]
    moves
      case dirsSimilar of
        [] -> Either Text Vector -> m (Either Text Vector)
    forall a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 :: forall (m :: * -> *).
    MonadClientRead m =>
    ActorId -> Vector -> m (Either Text Vector)
    checkAndRun ActorId
    aid Vector
    dir = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      actorMaxSkills <- getsState sactorMaxSkills
      body <- getsState $ getActorBody aid
      fact <- getsState $ (EM.! bfid body) . sfactionD
      smarkSuspect <- getsClient smarkSuspect
      let lid = Actor -> LevelId
    blid Actor
    body
      lvl <- getLevel lid
      actorD <- getsState sactorD
      let posHere = Actor -> Point
    bpos Actor
    body
          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
    posHere Point -> Vector -> Point
    `shift` Vector
    dir
          bigActorThere = Point -> Level -> Bool
    occupiedBigLvl Point
    posThere Level
    lvl
          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 = Point -> Level -> Bool
    occupiedProjLvl Point
    posThere Level
    lvl
      let posLast = Point -> Maybe Point -> Point
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Point
    forall a. HasCallStack => String -> a
    error (String -> Point) -> String -> Point
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    body)) (Actor -> Maybe Point
    boldpos Actor
    body)
          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
    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 = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    posLast
          tileHere = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    posHere
          tileThere = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    posThere
          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 = (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 -> 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 -> 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 = (Point -> ContentId TileKind) -> [Point] -> [ContentId TileKind]
    forall a b. (a -> b) -> [a] -> [b]
    map (Level
    lvl Level -> Point -> ContentId TileKind
    `at`) [Point]
    leftPsLast
          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 = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    leftForwardPosHere
          rightForwardTileHere = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    rightForwardPosHere
          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 = 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 = 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 = 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 = 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 = 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
            | Bool
    bigActorThere = Either Text Vector -> m (Either Text Vector)
    forall a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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 a. a -> m a
    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
      check