    {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, RankNTypes,
                 TypeFamilies #-}
    -- | Breadth first search algorithm.
    module Game.LambdaHack.Client.Bfs
      ( BfsDistance, MoveLegal(..)
      , subtractBfsDistance, minKnownBfs, apartBfs, maxBfsDistance, fillBfs
      , AndPath(..), findPathBfs, accessBfs
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , succBfsDistance, predBfsDistance, abortedUnknownBfs, maskBfs, distanceBfs
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Control.Monad.ST.Strict (ST, runST)
    import           Data.Binary
    import           Data.Bits (Bits, complement, (.&.), (.|.))
    import qualified Data.EnumSet as ES
    import qualified Data.IntSet as IS
    import qualified Data.Primitive.PrimArray as PA
    import qualified Data.Vector.Unboxed as U
    import qualified Data.Vector.Unboxed.Mutable as VM
    import           GHC.Exts (inline)
    import           GHC.Generics (Generic)

    import           Game.LambdaHack.Common.Point
    import qualified Game.LambdaHack.Common.PointArray as PointArray
    import           Game.LambdaHack.Common.Vector
    import           Game.LambdaHack.Definition.Defs

    -- @Word8@ is much faster, but in some very rare cases leads to AI loops,
    -- e.g., when a move through uknown terrain towards enemy stash
    -- goes beyond the @apartBfs@ range and makes AI abandon the stash target,
    -- only to pick it up after a step in the opposite direction.
    -- In normal LH maps, path length can get to around 200,
    -- in contrived mazes it could perhaps reach a few thousand.
    type DistanceWord = Word16

    -- | Weighted distance between points along shortest paths.
    newtype BfsDistance = BfsDistance {BfsDistance -> DistanceWord
    bfsDistance :: DistanceWord}
      deriving (X -> BfsDistance -> ShowS
    [BfsDistance] -> ShowS
    BfsDistance -> String
    (X -> BfsDistance -> ShowS)
    -> (BfsDistance -> String)
    -> ([BfsDistance] -> ShowS)
    -> Show BfsDistance
    forall a.
    (X -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: X -> BfsDistance -> ShowS
    showsPrec :: X -> BfsDistance -> ShowS
    $cshow :: BfsDistance -> String
    show :: BfsDistance -> String
    $cshowList :: [BfsDistance] -> ShowS
    showList :: [BfsDistance] -> ShowS
    Show, BfsDistance -> BfsDistance -> Bool
    (BfsDistance -> BfsDistance -> Bool)
    -> (BfsDistance -> BfsDistance -> Bool) -> Eq BfsDistance
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: BfsDistance -> BfsDistance -> Bool
    == :: BfsDistance -> BfsDistance -> Bool
    $c/= :: BfsDistance -> BfsDistance -> Bool
    /= :: BfsDistance -> BfsDistance -> Bool
    Eq, Eq BfsDistance
    Eq BfsDistance =>
    (BfsDistance -> BfsDistance -> Ordering)
    -> (BfsDistance -> BfsDistance -> Bool)
    -> (BfsDistance -> BfsDistance -> Bool)
    -> (BfsDistance -> BfsDistance -> Bool)
    -> (BfsDistance -> BfsDistance -> Bool)
    -> (BfsDistance -> BfsDistance -> BfsDistance)
    -> (BfsDistance -> BfsDistance -> BfsDistance)
    -> Ord BfsDistance
    BfsDistance -> BfsDistance -> Bool
    BfsDistance -> BfsDistance -> Ordering
    BfsDistance -> BfsDistance -> BfsDistance
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: BfsDistance -> BfsDistance -> Ordering
    compare :: BfsDistance -> BfsDistance -> Ordering
    $c< :: BfsDistance -> BfsDistance -> Bool
    < :: BfsDistance -> BfsDistance -> Bool
    $c<= :: BfsDistance -> BfsDistance -> Bool
    <= :: BfsDistance -> BfsDistance -> Bool
    $c> :: BfsDistance -> BfsDistance -> Bool
    > :: BfsDistance -> BfsDistance -> Bool
    $c>= :: BfsDistance -> BfsDistance -> Bool
    >= :: BfsDistance -> BfsDistance -> Bool
    $cmax :: BfsDistance -> BfsDistance -> BfsDistance
    max :: BfsDistance -> BfsDistance -> BfsDistance
    $cmin :: BfsDistance -> BfsDistance -> BfsDistance
    min :: BfsDistance -> BfsDistance -> BfsDistance
    Ord, Eq BfsDistance
    BfsDistance
    Eq BfsDistance =>
    (BfsDistance -> BfsDistance -> BfsDistance)
    -> (BfsDistance -> BfsDistance -> BfsDistance)
    -> (BfsDistance -> BfsDistance -> BfsDistance)
    -> (BfsDistance -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> BfsDistance
    -> (X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> Bool)
    -> (BfsDistance -> Maybe X)
    -> (BfsDistance -> X)
    -> (BfsDistance -> Bool)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X -> BfsDistance)
    -> (BfsDistance -> X)
    -> Bits BfsDistance
    X -> BfsDistance
    BfsDistance -> Bool
    BfsDistance -> X
    BfsDistance -> Maybe X
    BfsDistance -> BfsDistance
    BfsDistance -> X -> Bool
    BfsDistance -> X -> BfsDistance
    BfsDistance -> BfsDistance -> BfsDistance
    forall a.
    Eq a =>
    (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a)
    -> (a -> X -> a)
    -> (a -> X -> a)
    -> a
    -> (X -> a)
    -> (a -> X -> a)
    -> (a -> X -> a)
    -> (a -> X -> a)
    -> (a -> X -> Bool)
    -> (a -> Maybe X)
    -> (a -> X)
    -> (a -> Bool)
    -> (a -> X -> a)
    -> (a -> X -> a)
    -> (a -> X -> a)
    -> (a -> X -> a)
    -> (a -> X -> a)
    -> (a -> X -> a)
    -> (a -> X)
    -> Bits a
    $c.&. :: BfsDistance -> BfsDistance -> BfsDistance
    .&. :: BfsDistance -> BfsDistance -> BfsDistance
    $c.|. :: BfsDistance -> BfsDistance -> BfsDistance
    .|. :: BfsDistance -> BfsDistance -> BfsDistance
    $cxor :: BfsDistance -> BfsDistance -> BfsDistance
    xor :: BfsDistance -> BfsDistance -> BfsDistance
    $ccomplement :: BfsDistance -> BfsDistance
    complement :: BfsDistance -> BfsDistance
    $cshift :: BfsDistance -> X -> BfsDistance
    shift :: BfsDistance -> X -> BfsDistance
    $crotate :: BfsDistance -> X -> BfsDistance
    rotate :: BfsDistance -> X -> BfsDistance
    $czeroBits :: BfsDistance
    zeroBits :: BfsDistance
    $cbit :: X -> BfsDistance
    bit :: X -> BfsDistance
    $csetBit :: BfsDistance -> X -> BfsDistance
    setBit :: BfsDistance -> X -> BfsDistance
    $cclearBit :: BfsDistance -> X -> BfsDistance
    clearBit :: BfsDistance -> X -> BfsDistance
    $ccomplementBit :: BfsDistance -> X -> BfsDistance
    complementBit :: BfsDistance -> X -> BfsDistance
    $ctestBit :: BfsDistance -> X -> Bool
    testBit :: BfsDistance -> X -> Bool
    $cbitSizeMaybe :: BfsDistance -> Maybe X
    bitSizeMaybe :: BfsDistance -> Maybe X
    $cbitSize :: BfsDistance -> X
    bitSize :: BfsDistance -> X
    $cisSigned :: BfsDistance -> Bool
    isSigned :: BfsDistance -> Bool
    $cshiftL :: BfsDistance -> X -> BfsDistance
    shiftL :: BfsDistance -> X -> BfsDistance
    $cunsafeShiftL :: BfsDistance -> X -> BfsDistance
    unsafeShiftL :: BfsDistance -> X -> BfsDistance
    $cshiftR :: BfsDistance -> X -> BfsDistance
    shiftR :: BfsDistance -> X -> BfsDistance
    $cunsafeShiftR :: BfsDistance -> X -> BfsDistance
    unsafeShiftR :: BfsDistance -> X -> BfsDistance
    $crotateL :: BfsDistance -> X -> BfsDistance
    rotateL :: BfsDistance -> X -> BfsDistance
    $crotateR :: BfsDistance -> X -> BfsDistance
    rotateR :: BfsDistance -> X -> BfsDistance
    $cpopCount :: BfsDistance -> X
    popCount :: BfsDistance -> X
    Bits)

    instance PointArray.UnboxRepClass BfsDistance where
      type UnboxRep BfsDistance = DistanceWord
      toUnboxRepUnsafe :: BfsDistance -> UnboxRep BfsDistance
    toUnboxRepUnsafe = BfsDistance -> DistanceWord
    BfsDistance -> UnboxRep BfsDistance
    bfsDistance
      fromUnboxRep :: UnboxRep BfsDistance -> BfsDistance
    fromUnboxRep = DistanceWord -> BfsDistance
    UnboxRep BfsDistance -> BfsDistance
    BfsDistance

    -- | State of legality of moves between adjacent points.
    data MoveLegal = MoveBlocked | MoveToOpen | MoveToClosed | MoveToUnknown
      deriving MoveLegal -> MoveLegal -> Bool
    (MoveLegal -> MoveLegal -> Bool)
    -> (MoveLegal -> MoveLegal -> Bool) -> Eq MoveLegal
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MoveLegal -> MoveLegal -> Bool
    == :: MoveLegal -> MoveLegal -> Bool
    $c/= :: MoveLegal -> MoveLegal -> Bool
    /= :: MoveLegal -> MoveLegal -> Bool
    Eq

    succBfsDistance :: BfsDistance -> BfsDistance
    succBfsDistance :: BfsDistance -> BfsDistance
    succBfsDistance BfsDistance
    d = DistanceWord -> BfsDistance
    BfsDistance (DistanceWord -> BfsDistance) -> DistanceWord -> BfsDistance
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> DistanceWord
    bfsDistance BfsDistance
    d DistanceWord -> DistanceWord -> DistanceWord
    forall a. Num a => a -> a -> a
    + DistanceWord
    1

    predBfsDistance :: BfsDistance -> BfsDistance
    predBfsDistance :: BfsDistance -> BfsDistance
    predBfsDistance BfsDistance
    d = DistanceWord -> BfsDistance
    BfsDistance (DistanceWord -> BfsDistance) -> DistanceWord -> BfsDistance
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> DistanceWord
    bfsDistance BfsDistance
    d DistanceWord -> DistanceWord -> DistanceWord
    forall a. Num a => a -> a -> a
    - DistanceWord
    1

    subtractBfsDistance :: BfsDistance -> BfsDistance -> Int
    subtractBfsDistance :: BfsDistance -> BfsDistance -> X
    subtractBfsDistance BfsDistance
    d1 BfsDistance
    d2 = DistanceWord -> X
    forall a. Enum a => a -> X
    fromEnum (DistanceWord -> X) -> DistanceWord -> X
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> DistanceWord
    bfsDistance BfsDistance
    d1 DistanceWord -> DistanceWord -> DistanceWord
    forall a. Num a => a -> a -> a
    - BfsDistance -> DistanceWord
    bfsDistance BfsDistance
    d2

    -- | The minimal distance value assigned to paths that don't enter
    -- any unknown tiles.
    minKnownBfs :: BfsDistance
    minKnownBfs :: BfsDistance
    minKnownBfs = DistanceWord -> BfsDistance
    BfsDistance (DistanceWord -> BfsDistance) -> DistanceWord -> BfsDistance
    forall a b. (a -> b) -> a -> b
    $ DistanceWord
    1 DistanceWord -> DistanceWord -> DistanceWord
    forall a. Num a => a -> a -> a
    + DistanceWord
    forall a. Bounded a => a
    maxBound DistanceWord -> DistanceWord -> DistanceWord
    forall a. Integral a => a -> a -> a
    `div` DistanceWord
    2

    -- | The distance value that denotes no legal path between points,
    -- either due to blocked tiles or pathfinding aborted at earlier tiles,
    -- e.g., due to unknown tiles.
    apartBfs :: BfsDistance
    apartBfs :: BfsDistance
    apartBfs = BfsDistance -> BfsDistance
    predBfsDistance BfsDistance
    minKnownBfs

    -- | Maximum value of the type.
    maxBfsDistance :: BfsDistance
    maxBfsDistance :: BfsDistance
    maxBfsDistance = DistanceWord -> BfsDistance
    BfsDistance (DistanceWord
    forall a. Bounded a => a
    maxBound :: DistanceWord)

    -- | The distance value that denotes that path search was aborted
    -- at this tile due to too large actual distance
    -- and that the tile was unknown.
    -- It is also a true distance value for this tile.
    abortedUnknownBfs :: BfsDistance
    abortedUnknownBfs :: BfsDistance
    abortedUnknownBfs = BfsDistance -> BfsDistance
    predBfsDistance BfsDistance
    apartBfs

    maskBfs :: BfsDistance -> BfsDistance
    {-# INLINE maskBfs #-}
    maskBfs :: BfsDistance -> BfsDistance
    maskBfs BfsDistance
    distance = BfsDistance
    distance BfsDistance -> BfsDistance -> BfsDistance
    forall a. Bits a => a -> a -> a
    .&. BfsDistance -> BfsDistance
    forall a. Bits a => a -> a
    complement BfsDistance
    minKnownBfs

    -- | Create and fill a BFS array for the given level.
    -- Unsafe array operations are OK here, because the intermediate
    -- values of the vector don't leak anywhere outside nor are kept unevaluated
    -- and so they can't be overwritten by the unsafe side-effect.
    --
    -- When computing move cost, we assume doors openable at no cost,
    -- because other actors use them, too, so the cost is shared and the extra
    -- visiblity is valuable, too. We treat unknown tiles specially.
    -- Whether suspect tiles are considered openable depends on @smarkSuspect@.
    --
    -- Instead of a BFS queue (list) we use the two tabs (arrays), for (JS) speed.
    fillBfs :: PointArray.Array Word8
            -> Word8
            -> Point
            -> (PA.PrimArray PointI, PA.PrimArray PointI)
            -> PointArray.Array BfsDistance
    fillBfs :: Array Word8
    -> Word8
    -> Point
    -> (PrimArray X, PrimArray X)
    -> Array BfsDistance
    fillBfs !Array Word8
    lalter !Word8
    alterSkill !Point
    source (!PrimArray X
    tabA, !PrimArray X
    tabB) = (forall s. ST s (Array BfsDistance)) -> Array BfsDistance
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Array BfsDistance)) -> Array BfsDistance)
    -> (forall s. ST s (Array BfsDistance)) -> Array BfsDistance
    forall a b. (a -> b) -> a -> b
    $ do
      let arr :: Array BfsDistance
    arr = X -> X -> BfsDistance -> Array BfsDistance
    forall c. UnboxRepClass c => X -> X -> c -> Array c
    PointArray.replicateA
                  (Array Word8 -> X
    forall c. Array c -> X
    PointArray.axsize Array Word8
    lalter) (Array Word8 -> X
    forall c. Array c -> X
    PointArray.aysize Array Word8
    lalter) BfsDistance
    apartBfs
      vThawed <- Vector DistanceWord
    -> ST s (MVector (PrimState (ST s)) DistanceWord)
    forall a (m :: * -> *).
    (Unbox a, PrimMonad m) =>
    Vector a -> m (MVector (PrimState m) a)
    U.unsafeThaw (Vector DistanceWord
     -> ST s (MVector (PrimState (ST s)) DistanceWord))
    -> Vector DistanceWord
    -> ST s (MVector (PrimState (ST s)) DistanceWord)
    forall a b. (a -> b) -> a -> b
    $ Array BfsDistance -> Vector (UnboxRep BfsDistance)
    forall c. Array c -> Vector (UnboxRep c)
    PointArray.avector Array BfsDistance
    arr
      tabAThawed <- PA.unsafeThawPrimArray tabA
      tabBThawed <- PA.unsafeThawPrimArray tabB
      fillBfsThawed lalter alterSkill (fromEnum source)
                    (tabAThawed, tabBThawed) vThawed
      void $ PA.unsafeFreezePrimArray tabAThawed
      void $ PA.unsafeFreezePrimArray tabBThawed
      void $ U.unsafeFreeze vThawed
      return arr

    type QueueIx = Int

    type NextQueueIx = Int

    -- So very low-level that not even under EXPOSE_INTERNAL.
    fillBfsThawed :: forall s.
                     PointArray.Array Word8
                  -> Word8
                  -> PointI
                  -> (PA.MutablePrimArray s PointI, PA.MutablePrimArray s PointI)
                  -> U.MVector s DistanceWord
                  -> ST s ()
    fillBfsThawed :: forall s.
    Array Word8
    -> Word8
    -> X
    -> (MutablePrimArray s X, MutablePrimArray s X)
    -> MVector s DistanceWord
    -> ST s ()
    fillBfsThawed !Array Word8
    lalter !Word8
    alterSkill !X
    sourceI
                  (!MutablePrimArray s X
    tabAThawed, !MutablePrimArray s X
    tabBThawed) !MVector s DistanceWord
    vThawed = do
      let unsafeReadI :: PointI -> ST s BfsDistance
          {-# INLINE unsafeReadI #-}
    #ifdef WITH_EXPENSIVE_ASSERTIONS
          unsafeReadI p = BfsDistance <$> VM.read vThawed p
            -- index checking is sometimes an expensive (kind of) assertion
    #else
          unsafeReadI :: X -> ST s BfsDistance
    unsafeReadI X
    p = DistanceWord -> BfsDistance
    BfsDistance (DistanceWord -> BfsDistance)
    -> ST s DistanceWord -> ST s BfsDistance
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVector (PrimState (ST s)) DistanceWord -> X -> ST s DistanceWord
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> X -> m a
    VM.unsafeRead MVector s DistanceWord
    MVector (PrimState (ST s)) DistanceWord
    vThawed X
    p
    #endif
          unsafeWriteI :: PointI -> BfsDistance -> ST s ()
          {-# INLINE unsafeWriteI #-}
    #ifdef WITH_EXPENSIVE_ASSERTIONS
          unsafeWriteI p c = VM.write vThawed p (bfsDistance c)
    #else
          unsafeWriteI :: X -> BfsDistance -> ST s ()
    unsafeWriteI X
    p BfsDistance
    c = MVector (PrimState (ST s)) DistanceWord
    -> X -> DistanceWord -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> X -> a -> m ()
    VM.unsafeWrite MVector s DistanceWord
    MVector (PrimState (ST s)) DistanceWord
    vThawed X
    p (BfsDistance -> DistanceWord
    bfsDistance BfsDistance
    c)
    #endif
          -- The two tabs (arrays) are used as a staged, optimized queue.
          -- The first tab is for writes, the second one for reads.
          -- They switch places in each recursive @bfs@ call.
          bfs :: PA.MutablePrimArray s PointI
              -> PA.MutablePrimArray s PointI
              -> BfsDistance
              -> QueueIx
              -> ST s ()
          bfs :: MutablePrimArray s X
    -> MutablePrimArray s X -> BfsDistance -> X -> ST s ()
    bfs !MutablePrimArray s X
    tabReadThawed !MutablePrimArray s X
    tabWriteThawed !BfsDistance
    distance !X
    prevQueueIx = do
            let unsafeReadCurrent :: QueueIx -> ST s PointI
                {-# INLINE unsafeReadCurrent #-}
                unsafeReadCurrent :: X -> ST s X
    unsafeReadCurrent = MutablePrimArray (PrimState (ST s)) X -> X -> ST s X
    forall a (m :: * -> *).
    (Prim a, PrimMonad m) =>
    MutablePrimArray (PrimState m) a -> X -> m a
    PA.readPrimArray MutablePrimArray s X
    MutablePrimArray (PrimState (ST s)) X
    tabReadThawed
                unsafeWriteNext :: QueueIx -> PointI -> ST s ()
                {-# INLINE unsafeWriteNext #-}
                unsafeWriteNext :: X -> X -> ST s ()
    unsafeWriteNext = MutablePrimArray (PrimState (ST s)) X -> X -> X -> ST s ()
    forall a (m :: * -> *).
    (Prim a, PrimMonad m) =>
    MutablePrimArray (PrimState m) a -> X -> a -> m ()
    PA.writePrimArray MutablePrimArray s X
    MutablePrimArray (PrimState (ST s)) X
    tabWriteThawed
                -- The accumulator and the result represent the index into the next
                -- queue tab, incremented after each write.
                processQueue :: QueueIx -> NextQueueIx -> ST s NextQueueIx
                processQueue :: X -> X -> ST s X
    processQueue !X
    currentQueueIx !X
    acc1 =
                  if X
    currentQueueIx X -> X -> Bool
    forall a. Eq a => a -> a -> Bool
    == -X
    1
                  then X -> ST s X
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return X
    acc1  -- all queued positions inspected
                  else do
                    pos <- X -> ST s X
    unsafeReadCurrent X
    currentQueueIx
                    let processMove :: (X, Y) -> NextQueueIx -> ST s NextQueueIx
                        {-# INLINE processMove #-}
                        processMove (X, X)
    move X
    acc2 = do
                          let p :: X
    p = X
    pos X -> X -> X
    forall a. Num a => a -> a -> a
    + (Vector -> X) -> Vector -> X
    forall a. a -> a
    inline Vector -> X
    forall a. Enum a => a -> X
    fromEnum ((X -> X -> Vector) -> (X, X) -> Vector
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry X -> X -> Vector
    Vector (X, X)
    move)
                          pDist <- X -> ST s BfsDistance
    unsafeReadI X
    p
                          if pDist /= apartBfs
                          then return acc2  -- the position visited already
                          else do
                            let alter :: Word8
                                !alter = Array Word8
    lalter Array Word8 -> X -> UnboxRep Word8
    forall c. UnboxRepClass c => Array c -> X -> UnboxRep c
    `PointArray.accessI` X
    p
                            if | alterSkill < alter -> return acc2
                               | alter == 1 -> do
                                 let distCompl = BfsDistance -> BfsDistance
    maskBfs BfsDistance
    distance
                                 unsafeWriteI p distCompl
                                 return acc2
                               | otherwise -> do
                                 unsafeWriteI p distance
                                 unsafeWriteNext acc2 p
                                 return $! acc2 + 1
                    -- Innermost loop over @moves@ manually unrolled for (JS) speed:
                    return acc1
                      >>= processMove (-1, -1)
                      >>= processMove (0, -1)
                      >>= processMove (1, -1)
                      >>= processMove (1, 0)
                      >>= processMove (1, 1)
                      >>= processMove (0, 1)
                      >>= processMove (-1, 1)
                      >>= processMove (-1, 0)
                      -- Recursive call to process next queue element:
                      >>= processQueue (currentQueueIx - 1)
            acc3 <- X -> X -> ST s X
    processQueue (X
    prevQueueIx X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1) X
    0
            let distanceNew = BfsDistance -> BfsDistance
    succBfsDistance BfsDistance
    distance
            if acc3 == 0 || distanceNew == maxBfsDistance
            then return () -- no more close enough dungeon positions
            else bfs tabWriteThawed tabReadThawed distanceNew acc3
    #ifdef WITH_EXPENSIVE_ASSERTIONS
      VM.write vThawed sourceI (bfsDistance minKnownBfs)
    #else
      MVector (PrimState (ST s)) DistanceWord
    -> X -> DistanceWord -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> X -> a -> m ()
    VM.unsafeWrite MVector s DistanceWord
    MVector (PrimState (ST s)) DistanceWord
    vThawed X
    sourceI (BfsDistance -> DistanceWord
    bfsDistance BfsDistance
    minKnownBfs)
    #endif
      MutablePrimArray (PrimState (ST s)) X -> X -> X -> ST s ()
    forall a (m :: * -> *).
    (Prim a, PrimMonad m) =>
    MutablePrimArray (PrimState m) a -> X -> a -> m ()
    PA.writePrimArray MutablePrimArray s X
    MutablePrimArray (PrimState (ST s)) X
    tabAThawed X
    0 X
    sourceI
      MutablePrimArray s X
    -> MutablePrimArray s X -> BfsDistance -> X -> ST s ()
    bfs MutablePrimArray s X
    tabAThawed MutablePrimArray s X
    tabBThawed (BfsDistance -> BfsDistance
    succBfsDistance BfsDistance
    minKnownBfs) X
    1

    data AndPath = AndPath
      { AndPath -> Point
    pathSource :: Point    -- never included in @pathList@
      , AndPath -> [Point]
    pathList   :: [Point]
      , AndPath -> Point
    pathGoal   :: Point    -- needn't be @last pathList@
      , AndPath -> X
    pathLen    :: Int      -- needn't be @length pathList@
      }
      deriving (X -> AndPath -> ShowS
    [AndPath] -> ShowS
    AndPath -> String
    (X -> AndPath -> ShowS)
    -> (AndPath -> String) -> ([AndPath] -> ShowS) -> Show AndPath
    forall a.
    (X -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: X -> AndPath -> ShowS
    showsPrec :: X -> AndPath -> ShowS
    $cshow :: AndPath -> String
    show :: AndPath -> String
    $cshowList :: [AndPath] -> ShowS
    showList :: [AndPath] -> ShowS
    Show, (forall x. AndPath -> Rep AndPath x)
    -> (forall x. Rep AndPath x -> AndPath) -> Generic AndPath
    forall x. Rep AndPath x -> AndPath
    forall x. AndPath -> Rep AndPath x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. AndPath -> Rep AndPath x
    from :: forall x. AndPath -> Rep AndPath x
    $cto :: forall x. Rep AndPath x -> AndPath
    to :: forall x. Rep AndPath x -> AndPath
    Generic)

    instance Binary AndPath

    -- | Find a path, without the source position, with the smallest length.
    -- The @eps@ coefficient determines which direction (of the closest
    -- directions available) that path should prefer, where 0 means north-west
    -- and 1 means north. The path tries hard to avoid actors and tries to avoid
    -- tiles that need altering and ambient light. Actors are avoided only close
    -- to the start of the path, because elsewhere they are likely to move
    -- before they are reached. Even projectiles are avoided,
    -- which sometimes has the effect of choosing a safer route
    -- (regardless if the projectiles are friendly fire or not).
    --
    -- An unwelcome side effect of avoiding actors is that friends will sometimes
    -- avoid displacing and instead perform two separate moves, wasting 1 turn
    -- in total (only if they had opposed direction of their goals; unlikely).
    -- But in corridors they will still displace and elsewhere this scenario
    -- was quite rare already.
    findPathBfs :: ES.EnumSet Point -> PointArray.Array Word8 -> (PointI -> Bool)
                -> Point -> Point -> Int
                -> PointArray.Array BfsDistance
                -> Maybe AndPath
    {-# INLINE findPathBfs #-}
    findPathBfs :: EnumSet Point
    -> Array Word8
    -> (X -> Bool)
    -> Point
    -> Point
    -> X
    -> Array BfsDistance
    -> Maybe AndPath
    findPathBfs EnumSet Point
    lbig Array Word8
    lalter X -> Bool
    fovLit Point
    pathSource Point
    pathGoal X
    sepsRaw Array BfsDistance
    arr =
      let !pathGoalI :: X
    pathGoalI = Point -> X
    forall a. Enum a => a -> X
    fromEnum Point
    pathGoal
          !pathSourceI :: X
    pathSourceI = Point -> X
    forall a. Enum a => a -> X
    fromEnum Point
    pathSource
          eps :: X
    eps = X
    sepsRaw X -> X -> X
    forall a. Integral a => a -> a -> a
    `mod` X
    4
          ([X]
    mc1, [X]
    mc2) = X -> [X] -> ([X], [X])
    forall a. X -> [a] -> ([a], [a])
    splitAt X
    eps [X]
    movesCardinalI
          ([X]
    md1, [X]
    md2) = X -> [X] -> ([X], [X])
    forall a. X -> [a] -> ([a], [a])
    splitAt X
    eps [X]
    movesDiagonalI
          -- Prefer cardinal directions when closer to the target, so that
          -- the enemy can't easily disengage.
          prefMoves :: [X]
    prefMoves = [X]
    mc2 [X] -> [X] -> [X]
    forall a. [a] -> [a] -> [a]
    ++ [X] -> [X]
    forall a. [a] -> [a]
    reverse [X]
    mc1 [X] -> [X] -> [X]
    forall a. [a] -> [a] -> [a]
    ++ [X]
    md2 [X] -> [X] -> [X]
    forall a. [a] -> [a] -> [a]
    ++ [X] -> [X]
    forall a. [a] -> [a]
    reverse [X]
    md1  -- fuzz
          track :: PointI -> BfsDistance -> [Point] -> [Point]
          track :: X -> BfsDistance -> [Point] -> [Point]
    track !X
    pos !BfsDistance
    oldDist ![Point]
    suffix | BfsDistance
    oldDist BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    == BfsDistance
    minKnownBfs =
            Bool -> [Point] -> [Point]
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (X
    pos X -> X -> Bool
    forall a. Eq a => a -> a -> Bool
    == X
    pathSourceI) [Point]
    suffix
          track X
    pos BfsDistance
    oldDist [Point]
    suffix | BfsDistance
    oldDist BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    == BfsDistance -> BfsDistance
    succBfsDistance BfsDistance
    minKnownBfs =
            let !posP :: Point
    posP = X -> Point
    forall a. Enum a => X -> a
    toEnum X
    pos
            in Point
    posP Point -> [Point] -> [Point]
    forall a. a -> [a] -> [a]
    : [Point]
    suffix  -- avoid calculating minP and dist for the last call
          track X
    pos BfsDistance
    oldDist [Point]
    suffix =
            let !dist :: BfsDistance
    dist = BfsDistance -> BfsDistance
    predBfsDistance BfsDistance
    oldDist
                minChild :: PointI -> Bool -> Word8 -> [VectorI] -> PointI
                minChild :: X -> Bool -> Word8 -> [X] -> X
    minChild !X
    minP Bool
    _ Word8
    _ [] = X
    minP
                minChild X
    minP Bool
    maxDark Word8
    minAlter (X
    mv : [X]
    mvs) =
                  let !p :: X
    p = X
    pos X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    mv
                      backtrackingMove :: Bool
    backtrackingMove =
                        DistanceWord -> BfsDistance
    BfsDistance (Array BfsDistance
    arr Array BfsDistance -> X -> UnboxRep BfsDistance
    forall c. UnboxRepClass c => Array c -> X -> UnboxRep c
    `PointArray.accessI` X
    p) BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BfsDistance
    dist
                  in if Bool
    backtrackingMove
                     then X -> Bool -> Word8 -> [X] -> X
    minChild X
    minP Bool
    maxDark Word8
    minAlter [X]
    mvs
                     else let free :: Bool
    free = X
    p X -> IntSet -> Bool
    `IS.notMember` EnumSet Point -> IntSet
    forall k. EnumSet k -> IntSet
    ES.enumSetToIntSet EnumSet Point
    lbig
                              alter :: UnboxRep Word8
    alter | Bool
    free = Array Word8
    lalter Array Word8 -> X -> UnboxRep Word8
    forall c. UnboxRepClass c => Array c -> X -> UnboxRep c
    `PointArray.accessI` X
    p
                                    | Bool
    otherwise = Word8
    forall a. Bounded a => a
    maxBoundWord8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    -Word8
    1  -- occupied; disaster
                              dark :: Bool
    dark = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ X -> Bool
    fovLit X
    p
                          -- Prefer paths without actors and through
                          -- more easily opened tiles and, secondly,
                          -- in the ambient dark (even if light carried,
                          -- because it can be taken off at any moment).
                          in if | Word8
    UnboxRep Word8
    alter Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0 Bool -> Bool -> Bool
    && Bool
    dark -> X
    p  -- speedup
                                | Word8
    UnboxRep Word8
    alter Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    minAlter -> X -> Bool -> Word8 -> [X] -> X
    minChild X
    p Bool
    dark Word8
    UnboxRep Word8
    alter [X]
    mvs
                                | Bool
    dark Bool -> Bool -> Bool
    forall a. Ord a => a -> a -> Bool
    > Bool
    maxDark Bool -> Bool -> Bool
    && Word8
    UnboxRep Word8
    alter Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    minAlter ->
                                  X -> Bool -> Word8 -> [X] -> X
    minChild X
    p Bool
    dark Word8
    UnboxRep Word8
    alter [X]
    mvs
                                | Bool
    otherwise -> X -> Bool -> Word8 -> [X] -> X
    minChild X
    minP Bool
    maxDark Word8
    minAlter [X]
    mvs
                -- @maxBound@ means not alterable, so some child will be lower
                !newPos :: X
    newPos = X -> Bool -> Word8 -> [X] -> X
    minChild X
    pos{-dummy-} Bool
    False Word8
    forall a. Bounded a => a
    maxBound [X]
    prefMoves
    #ifdef WITH_EXPENSIVE_ASSERTIONS
                !_A = assert (newPos /= pos) ()
    #endif
                !posP :: Point
    posP = X -> Point
    forall a. Enum a => X -> a
    toEnum X
    pos
            in X -> BfsDistance -> [Point] -> [Point]
    track X
    newPos BfsDistance
    dist (Point
    posP Point -> [Point] -> [Point]
    forall a. a -> [a] -> [a]
    : [Point]
    suffix)
          !goalDist :: BfsDistance
    goalDist = DistanceWord -> BfsDistance
    BfsDistance (DistanceWord -> BfsDistance) -> DistanceWord -> BfsDistance
    forall a b. (a -> b) -> a -> b
    $ Array BfsDistance
    arr Array BfsDistance -> X -> UnboxRep BfsDistance
    forall c. UnboxRepClass c => Array c -> X -> UnboxRep c
    `PointArray.accessI` X
    pathGoalI
          pathLen :: X
    pathLen = DistanceWord -> X
    forall a. Enum a => a -> X
    fromEnum (DistanceWord -> X) -> DistanceWord -> X
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> DistanceWord
    bfsDistance (BfsDistance -> DistanceWord) -> BfsDistance -> DistanceWord
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> BfsDistance
    maskBfs BfsDistance
    goalDist
          pathList :: [Point]
    pathList = X -> BfsDistance -> [Point] -> [Point]
    track X
    pathGoalI (BfsDistance
    goalDist BfsDistance -> BfsDistance -> BfsDistance
    forall a. Bits a => a -> a -> a
    .|. BfsDistance
    minKnownBfs) []
          andPath :: AndPath
    andPath = AndPath{X
    [Point]
    Point
    pathSource :: Point
    pathList :: [Point]
    pathGoal :: Point
    pathLen :: X
    pathSource :: Point
    pathGoal :: Point
    pathLen :: X
    pathList :: [Point]
    ..}
      in Bool -> Maybe AndPath -> Maybe AndPath
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (DistanceWord -> BfsDistance
    BfsDistance (Array BfsDistance
    arr Array BfsDistance -> X -> UnboxRep BfsDistance
    forall c. UnboxRepClass c => Array c -> X -> UnboxRep c
    `PointArray.accessI` X
    pathSourceI)
                 BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    == BfsDistance
    minKnownBfs) (Maybe AndPath -> Maybe AndPath) -> Maybe AndPath -> Maybe AndPath
    forall a b. (a -> b) -> a -> b
    $
         if BfsDistance
    goalDist BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BfsDistance
    apartBfs Bool -> Bool -> Bool
    && X
    pathLen X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * Point -> Point -> X
    chessDist Point
    pathSource Point
    pathGoal
         then AndPath -> Maybe AndPath
    forall a. a -> Maybe a
    Just AndPath
    andPath
         else let f :: (Point, Int, Int, Int) -> Point -> BfsDistance
                    -> (Point, Int, Int, Int)
                  f :: (Point, X, X, X) -> Point -> BfsDistance -> (Point, X, X, X)
    f acc :: (Point, X, X, X)
    acc@(Point
    pAcc, X
    dAcc, X
    chessAcc, X
    sumAcc) Point
    p BfsDistance
    d =
                    if BfsDistance
    d BfsDistance -> BfsDistance -> Bool
    forall a. Ord a => a -> a -> Bool
    <= BfsDistance
    abortedUnknownBfs  -- works in visible secrets mode only
                       Bool -> Bool -> Bool
    || BfsDistance
    d BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BfsDistance
    apartBfs Bool -> Bool -> Bool
    && Point -> Point -> Bool
    adjacent Point
    p Point
    pathGoal  -- works for stairs
                    then let dist :: X
    dist = DistanceWord -> X
    forall a. Enum a => a -> X
    fromEnum (DistanceWord -> X) -> DistanceWord -> X
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> DistanceWord
    bfsDistance (BfsDistance -> DistanceWord) -> BfsDistance -> DistanceWord
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> BfsDistance
    maskBfs BfsDistance
    d
                             chessNew :: X
    chessNew = Point -> Point -> X
    chessDist Point
    p Point
    pathGoal
                             sumNew :: X
    sumNew = X
    dist X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    chessNew
                             resNew :: (Point, X, X, X)
    resNew = (Point
    p, X
    dist, X
    chessNew, X
    sumNew)
                         in case X -> X -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare X
    sumNew X
    sumAcc of
                           Ordering
    LT -> (Point, X, X, X)
    resNew
                           Ordering
    EQ -> case X -> X -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare X
    chessNew X
    chessAcc of
                             Ordering
    LT -> (Point, X, X, X)
    resNew
                             Ordering
    EQ -> case X -> X -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare X
    dist X
    dAcc of
                               Ordering
    LT -> (Point, X, X, X)
    resNew
                               Ordering
    EQ | Point -> Point -> X
    euclidDistSq Point
    p Point
    pathGoal
                                    X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < Point -> Point -> X
    euclidDistSq Point
    pAcc Point
    pathGoal -> (Point, X, X, X)
    resNew
                               Ordering
    _ -> (Point, X, X, X)
    acc
                             Ordering
    _ -> (Point, X, X, X)
    acc
                           Ordering
    _ -> (Point, X, X, X)
    acc
                    else (Point, X, X, X)
    acc
                  initAcc :: (Point, X, X, X)
    initAcc = (Point
    originPoint, X
    forall a. Bounded a => a
    maxBound, X
    forall a. Bounded a => a
    maxBound, X
    forall a. Bounded a => a
    maxBound)
                  (Point
    pRes, X
    dRes, X
    _, X
    sumRes) = ((Point, X, X, X) -> Point -> BfsDistance -> (Point, X, X, X))
    -> (Point, X, X, X) -> Array BfsDistance -> (Point, X, X, X)
    forall c a.
    UnboxRepClass c =>
    (a -> Point -> c -> a) -> a -> Array c -> a
    PointArray.ifoldlA' (Point, X, X, X) -> Point -> BfsDistance -> (Point, X, X, X)
    f (Point, X, X, X)
    initAcc Array BfsDistance
    arr
              in if X
    sumRes X -> X -> Bool
    forall a. Eq a => a -> a -> Bool
    == X
    forall a. Bounded a => a
    maxBound
                    Bool -> Bool -> Bool
    || BfsDistance
    goalDist BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BfsDistance
    apartBfs Bool -> Bool -> Bool
    && X
    pathLen X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    sumRes
                 then if BfsDistance
    goalDist BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BfsDistance
    apartBfs then AndPath -> Maybe AndPath
    forall a. a -> Maybe a
    Just AndPath
    andPath else Maybe AndPath
    forall a. Maybe a
    Nothing
                 else let pathList2 :: [Point]
    pathList2 =
                            X -> BfsDistance -> [Point] -> [Point]
    track (Point -> X
    forall a. Enum a => a -> X
    fromEnum Point
    pRes)
                                  (DistanceWord -> BfsDistance
    BfsDistance (X -> DistanceWord
    forall a. Enum a => X -> a
    toEnum X
    dRes) BfsDistance -> BfsDistance -> BfsDistance
    forall a. Bits a => a -> a -> a
    .|. BfsDistance
    minKnownBfs) []
                      in AndPath -> Maybe AndPath
    forall a. a -> Maybe a
    Just AndPath{pathList :: [Point]
    pathList = [Point]
    pathList2, pathLen :: X
    pathLen = X
    sumRes, Point
    pathSource :: Point
    pathGoal :: Point
    pathSource :: Point
    pathGoal :: Point
    ..}

    -- | Access a BFS array and interpret the looked up distance value.
    accessBfs :: PointArray.Array BfsDistance -> Point -> Maybe Int
    accessBfs :: Array BfsDistance -> Point -> Maybe X
    accessBfs Array BfsDistance
    bfs Point
    p = if Array BfsDistance -> X
    forall c. Array c -> X
    PointArray.axsize Array BfsDistance
    bfs X -> X -> Bool
    forall a. Eq a => a -> a -> Bool
    == X
    0
                      then Maybe X
    forall a. Maybe a
    Nothing
                      else BfsDistance -> Maybe X
    distanceBfs (BfsDistance -> Maybe X) -> BfsDistance -> Maybe X
    forall a b. (a -> b) -> a -> b
    $ Array BfsDistance
    bfs Array BfsDistance -> Point -> BfsDistance
    forall c. UnboxRepClass c => Array c -> Point -> c
    PointArray.! Point
    p

    distanceBfs :: BfsDistance -> Maybe Int
    {-# INLINE distanceBfs #-}
    distanceBfs :: BfsDistance -> Maybe X
    distanceBfs BfsDistance
    dist = if BfsDistance
    dist BfsDistance -> BfsDistance -> Bool
    forall a. Eq a => a -> a -> Bool
    == BfsDistance
    apartBfs
                       then Maybe X
    forall a. Maybe a
    Nothing
                       else X -> Maybe X
    forall a. a -> Maybe a
    Just (X -> Maybe X) -> X -> Maybe X
    forall a b. (a -> b) -> a -> b
    $ DistanceWord -> X
    forall a. Enum a => a -> X
    fromEnum (DistanceWord -> X) -> DistanceWord -> X
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> DistanceWord
    bfsDistance (BfsDistance -> DistanceWord) -> BfsDistance -> DistanceWord
    forall a b. (a -> b) -> a -> b
    $ BfsDistance -> BfsDistance
    maskBfs BfsDistance
    dist