{-# 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
  MVector s DistanceWord
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
  MutablePrimArray s X
tabAThawed <- PrimArray X -> ST s (MutablePrimArray (PrimState (ST s)) X)
forall (m :: * -> *) a.
PrimMonad m =>
PrimArray a -> m (MutablePrimArray (PrimState m) a)
PA.unsafeThawPrimArray PrimArray X
tabA
  MutablePrimArray s X
tabBThawed <- PrimArray X -> ST s (MutablePrimArray (PrimState (ST s)) X)
forall (m :: * -> *) a.
PrimMonad m =>
PrimArray a -> m (MutablePrimArray (PrimState m) a)
PA.unsafeThawPrimArray PrimArray X
tabB
  Array Word8
-> Word8
-> X
-> (MutablePrimArray s X, MutablePrimArray s X)
-> MVector s DistanceWord
-> ST s ()
forall s.
Array Word8
-> Word8
-> X
-> (MutablePrimArray s X, MutablePrimArray s X)
-> MVector s DistanceWord
-> ST s ()
fillBfsThawed Array Word8
lalter Word8
alterSkill (Point -> X
forall a. Enum a => a -> X
fromEnum Point
source)
                (MutablePrimArray s X
tabAThawed, MutablePrimArray s X
tabBThawed) MVector s DistanceWord
vThawed
  ST s (PrimArray X) -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s (PrimArray X) -> ST s ()) -> ST s (PrimArray X) -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutablePrimArray (PrimState (ST s)) X -> ST s (PrimArray X)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PA.unsafeFreezePrimArray MutablePrimArray s X
MutablePrimArray (PrimState (ST s)) X
tabAThawed
  ST s (PrimArray X) -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s (PrimArray X) -> ST s ()) -> ST s (PrimArray X) -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutablePrimArray (PrimState (ST s)) X -> ST s (PrimArray X)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PA.unsafeFreezePrimArray MutablePrimArray s X
MutablePrimArray (PrimState (ST s)) X
tabBThawed
  ST s (Vector DistanceWord) -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s (Vector DistanceWord) -> ST s ())
-> ST s (Vector DistanceWord) -> ST s ()
forall a b. (a -> b) -> a -> b
$ MVector (PrimState (ST s)) DistanceWord
-> ST s (Vector DistanceWord)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.unsafeFreeze MVector s DistanceWord
MVector (PrimState (ST s)) DistanceWord
vThawed
  Array BfsDistance -> ST s (Array BfsDistance)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Array BfsDistance
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 :: 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.read MVector s DistanceWord
MVector (PrimState (ST s)) DistanceWord
vThawed X
p
        -- index checking is sometimes an expensive (kind of) assertion
#else
      unsafeReadI p = BfsDistance <$> VM.unsafeRead vThawed p
#endif
      unsafeWriteI :: PointI -> BfsDistance -> ST s ()
      {-# INLINE unsafeWriteI #-}
#ifdef WITH_EXPENSIVE_ASSERTIONS
      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.write MVector s DistanceWord
MVector (PrimState (ST s)) DistanceWord
vThawed X
p (BfsDistance -> DistanceWord
bfsDistance BfsDistance
c)
#else
      unsafeWriteI p c = VM.unsafeWrite vThawed p (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
                X
pos <- X -> ST s X
unsafeReadCurrent X
currentQueueIx
                let processMove :: (X, Y) -> NextQueueIx -> ST s NextQueueIx
                    {-# INLINE processMove #-}
                    processMove :: (X, X) -> X -> ST s X
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)
                      BfsDistance
pDist <- X -> ST s BfsDistance
unsafeReadI X
p
                      if BfsDistance
pDist BfsDistance -> BfsDistance -> Bool
forall a. Eq a => a -> a -> Bool
/= BfsDistance
apartBfs
                      then X -> ST s X
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return X
acc2  -- the position visited already
                      else do
                        let alter :: Word8
                            !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 | Word8
alterSkill Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
alter -> X -> ST s X
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return X
acc2
                           | Word8
alter Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 -> do
                             let distCompl :: BfsDistance
distCompl = BfsDistance -> BfsDistance
maskBfs BfsDistance
distance
                             X -> BfsDistance -> ST s ()
unsafeWriteI X
p BfsDistance
distCompl
                             X -> ST s X
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return X
acc2
                           | Bool
otherwise -> do
                             X -> BfsDistance -> ST s ()
unsafeWriteI X
p BfsDistance
distance
                             X -> X -> ST s ()
unsafeWriteNext X
acc2 X
p
                             X -> ST s X
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (X -> ST s X) -> X -> ST s X
forall a b. (a -> b) -> a -> b
$! X
acc2 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1
                -- Innermost loop over @moves@ manually unrolled for (JS) speed:
                X -> ST s X
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return X
acc1
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X, X) -> X -> ST s X
processMove (-X
1, -X
1)
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X, X) -> X -> ST s X
processMove (X
0, -X
1)
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X, X) -> X -> ST s X
processMove (X
1, -X
1)
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X, X) -> X -> ST s X
processMove (X
1, X
0)
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X, X) -> X -> ST s X
processMove (X
1, X
1)
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X, X) -> X -> ST s X
processMove (X
0, X
1)
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X, X) -> X -> ST s X
processMove (-X
1, X
1)
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X, X) -> X -> ST s X
processMove (-X
1, X
0)
                  -- Recursive call to process next queue element:
                  ST s X -> (X -> ST s X) -> ST s X
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= X -> X -> ST s X
processQueue (X
currentQueueIx X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
        X
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
distanceNew = BfsDistance -> BfsDistance
succBfsDistance BfsDistance
distance
        if X
acc3 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
0 Bool -> Bool -> Bool
|| BfsDistance
distanceNew BfsDistance -> BfsDistance -> Bool
forall a. Eq a => a -> a -> Bool
== BfsDistance
maxBfsDistance
        then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- no more close enough dungeon positions
        else MutablePrimArray s X
-> MutablePrimArray s X -> BfsDistance -> X -> ST s ()
bfs MutablePrimArray s X
tabWriteThawed MutablePrimArray s X
tabReadThawed BfsDistance
distanceNew X
acc3
#ifdef WITH_EXPENSIVE_ASSERTIONS
  MVector (PrimState (ST s)) DistanceWord
-> X -> DistanceWord -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> X -> a -> m ()
VM.write MVector s DistanceWord
MVector (PrimState (ST s)) DistanceWord
vThawed X
sourceI (BfsDistance -> DistanceWord
bfsDistance BfsDistance
minKnownBfs)
#else
  VM.unsafeWrite vThawed sourceI (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 :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (X
newPos X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= X
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