{-# 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 (Int -> BfsDistance -> ShowS
[BfsDistance] -> ShowS
BfsDistance -> String
(Int -> BfsDistance -> ShowS)
-> (BfsDistance -> String)
-> ([BfsDistance] -> ShowS)
-> Show BfsDistance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BfsDistance] -> ShowS
$cshowList :: [BfsDistance] -> ShowS
show :: BfsDistance -> String
$cshow :: BfsDistance -> String
showsPrec :: Int -> BfsDistance -> ShowS
$cshowsPrec :: Int -> BfsDistance -> ShowS
Show, BfsDistance -> BfsDistance -> Bool
(BfsDistance -> BfsDistance -> Bool)
-> (BfsDistance -> BfsDistance -> Bool) -> Eq BfsDistance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BfsDistance -> BfsDistance -> Bool
$c/= :: BfsDistance -> BfsDistance -> Bool
== :: BfsDistance -> BfsDistance -> Bool
$c== :: 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
min :: BfsDistance -> BfsDistance -> BfsDistance
$cmin :: BfsDistance -> BfsDistance -> BfsDistance
max :: BfsDistance -> BfsDistance -> BfsDistance
$cmax :: BfsDistance -> BfsDistance -> BfsDistance
>= :: BfsDistance -> BfsDistance -> Bool
$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
compare :: BfsDistance -> BfsDistance -> Ordering
$ccompare :: BfsDistance -> BfsDistance -> Ordering
$cp1Ord :: Eq BfsDistance
Ord, Eq BfsDistance
BfsDistance
Eq BfsDistance
-> (BfsDistance -> BfsDistance -> BfsDistance)
-> (BfsDistance -> BfsDistance -> BfsDistance)
-> (BfsDistance -> BfsDistance -> BfsDistance)
-> (BfsDistance -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> BfsDistance
-> (Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> Bool)
-> (BfsDistance -> Maybe Int)
-> (BfsDistance -> Int)
-> (BfsDistance -> Bool)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int -> BfsDistance)
-> (BfsDistance -> Int)
-> Bits BfsDistance
Int -> BfsDistance
BfsDistance -> Bool
BfsDistance -> Int
BfsDistance -> Maybe Int
BfsDistance -> BfsDistance
BfsDistance -> Int -> Bool
BfsDistance -> Int -> BfsDistance
BfsDistance -> BfsDistance -> BfsDistance
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: BfsDistance -> Int
$cpopCount :: BfsDistance -> Int
rotateR :: BfsDistance -> Int -> BfsDistance
$crotateR :: BfsDistance -> Int -> BfsDistance
rotateL :: BfsDistance -> Int -> BfsDistance
$crotateL :: BfsDistance -> Int -> BfsDistance
unsafeShiftR :: BfsDistance -> Int -> BfsDistance
$cunsafeShiftR :: BfsDistance -> Int -> BfsDistance
shiftR :: BfsDistance -> Int -> BfsDistance
$cshiftR :: BfsDistance -> Int -> BfsDistance
unsafeShiftL :: BfsDistance -> Int -> BfsDistance
$cunsafeShiftL :: BfsDistance -> Int -> BfsDistance
shiftL :: BfsDistance -> Int -> BfsDistance
$cshiftL :: BfsDistance -> Int -> BfsDistance
isSigned :: BfsDistance -> Bool
$cisSigned :: BfsDistance -> Bool
bitSize :: BfsDistance -> Int
$cbitSize :: BfsDistance -> Int
bitSizeMaybe :: BfsDistance -> Maybe Int
$cbitSizeMaybe :: BfsDistance -> Maybe Int
testBit :: BfsDistance -> Int -> Bool
$ctestBit :: BfsDistance -> Int -> Bool
complementBit :: BfsDistance -> Int -> BfsDistance
$ccomplementBit :: BfsDistance -> Int -> BfsDistance
clearBit :: BfsDistance -> Int -> BfsDistance
$cclearBit :: BfsDistance -> Int -> BfsDistance
setBit :: BfsDistance -> Int -> BfsDistance
$csetBit :: BfsDistance -> Int -> BfsDistance
bit :: Int -> BfsDistance
$cbit :: Int -> BfsDistance
zeroBits :: BfsDistance
$czeroBits :: BfsDistance
rotate :: BfsDistance -> Int -> BfsDistance
$crotate :: BfsDistance -> Int -> BfsDistance
shift :: BfsDistance -> Int -> BfsDistance
$cshift :: BfsDistance -> Int -> BfsDistance
complement :: BfsDistance -> BfsDistance
$ccomplement :: BfsDistance -> BfsDistance
xor :: BfsDistance -> BfsDistance -> BfsDistance
$cxor :: BfsDistance -> BfsDistance -> BfsDistance
.|. :: BfsDistance -> BfsDistance -> BfsDistance
$c.|. :: BfsDistance -> BfsDistance -> BfsDistance
.&. :: BfsDistance -> BfsDistance -> BfsDistance
$c.&. :: BfsDistance -> BfsDistance -> BfsDistance
$cp1Bits :: Eq BfsDistance
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
/= :: MoveLegal -> MoveLegal -> Bool
$c/= :: MoveLegal -> MoveLegal -> Bool
== :: MoveLegal -> MoveLegal -> Bool
$c== :: 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 -> Int
subtractBfsDistance BfsDistance
d1 BfsDistance
d2 = DistanceWord -> Int
forall a. Enum a => a -> Int
fromEnum (DistanceWord -> Int) -> DistanceWord -> Int
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 Int, PrimArray Int)
-> Array BfsDistance
fillBfs !Array Word8
lalter !Word8
alterSkill !Point
source (!PrimArray Int
tabA, !PrimArray Int
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 = Int -> Int -> BfsDistance -> Array BfsDistance
forall c. UnboxRepClass c => Int -> Int -> c -> Array c
PointArray.replicateA
              (Array Word8 -> Int
forall c. Array c -> Int
PointArray.axsize Array Word8
lalter) (Array Word8 -> Int
forall c. Array c -> Int
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 Int
tabAThawed <- PrimArray Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
PrimMonad m =>
PrimArray a -> m (MutablePrimArray (PrimState m) a)
PA.unsafeThawPrimArray PrimArray Int
tabA
  MutablePrimArray s Int
tabBThawed <- PrimArray Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
PrimMonad m =>
PrimArray a -> m (MutablePrimArray (PrimState m) a)
PA.unsafeThawPrimArray PrimArray Int
tabB
  Array Word8
-> Word8
-> Int
-> (MutablePrimArray s Int, MutablePrimArray s Int)
-> MVector s DistanceWord
-> ST s ()
forall s.
Array Word8
-> Word8
-> Int
-> (MutablePrimArray s Int, MutablePrimArray s Int)
-> MVector s DistanceWord
-> ST s ()
fillBfsThawed Array Word8
lalter Word8
alterSkill (Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
source)
                (MutablePrimArray s Int
tabAThawed, MutablePrimArray s Int
tabBThawed) MVector s DistanceWord
vThawed
  ST s (PrimArray Int) -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s (PrimArray Int) -> ST s ())
-> ST s (PrimArray Int) -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutablePrimArray (PrimState (ST s)) Int -> ST s (PrimArray Int)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PA.unsafeFreezePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
tabAThawed
  ST s (PrimArray Int) -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s (PrimArray Int) -> ST s ())
-> ST s (PrimArray Int) -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutablePrimArray (PrimState (ST s)) Int -> ST s (PrimArray Int)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PA.unsafeFreezePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
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 (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 :: Array Word8
-> Word8
-> Int
-> (MutablePrimArray s Int, MutablePrimArray s Int)
-> MVector s DistanceWord
-> ST s ()
fillBfsThawed !Array Word8
lalter !Word8
alterSkill !Int
sourceI
              (!MutablePrimArray s Int
tabAThawed, !MutablePrimArray s Int
tabBThawed) !MVector s DistanceWord
vThawed = do
  let unsafeReadI :: PointI -> ST s BfsDistance
      {-# INLINE unsafeReadI #-}
      unsafeReadI :: Int -> ST s BfsDistance
unsafeReadI Int
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 -> Int -> ST s DistanceWord
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
VM.unsafeRead MVector s DistanceWord
MVector (PrimState (ST s)) DistanceWord
vThawed Int
p
      unsafeWriteI :: PointI -> BfsDistance -> ST s ()
      {-# INLINE unsafeWriteI #-}
      unsafeWriteI :: Int -> BfsDistance -> ST s ()
unsafeWriteI Int
p BfsDistance
c = MVector (PrimState (ST s)) DistanceWord
-> Int -> DistanceWord -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.unsafeWrite MVector s DistanceWord
MVector (PrimState (ST s)) DistanceWord
vThawed Int
p (BfsDistance -> DistanceWord
bfsDistance BfsDistance
c)
      -- 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 Int
-> MutablePrimArray s Int -> BfsDistance -> Int -> ST s ()
bfs !MutablePrimArray s Int
tabReadThawed !MutablePrimArray s Int
tabWriteThawed !BfsDistance
distance !Int
prevQueueIx = do
        let unsafeReadCurrent :: QueueIx -> ST s PointI
            {-# INLINE unsafeReadCurrent #-}
            unsafeReadCurrent :: Int -> ST s Int
unsafeReadCurrent = MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PA.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
tabReadThawed
            unsafeWriteNext :: QueueIx -> PointI -> ST s ()
            {-# INLINE unsafeWriteNext #-}
            unsafeWriteNext :: Int -> Int -> ST s ()
unsafeWriteNext = MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PA.writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
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 :: Int -> Int -> ST s Int
processQueue !Int
currentQueueIx !Int
acc1 =
              if Int
currentQueueIx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1
              then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
acc1  -- all queued positions inspected
              else do
                Int
pos <- Int -> ST s Int
unsafeReadCurrent Int
currentQueueIx
                let processMove :: (X, Y) -> NextQueueIx -> ST s NextQueueIx
                    {-# INLINE processMove #-}
                    processMove :: (Int, Int) -> Int -> ST s Int
processMove (Int, Int)
move Int
acc2 = do
                      let p :: Int
p = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Vector -> Int) -> Vector -> Int
forall a. a -> a
inline Vector -> Int
forall a. Enum a => a -> Int
fromEnum ((Int -> Int -> Vector) -> (Int, Int) -> Vector
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Vector
Vector (Int, Int)
move)
                      BfsDistance
pDist <- Int -> ST s BfsDistance
unsafeReadI Int
p
                      if BfsDistance
pDist BfsDistance -> BfsDistance -> Bool
forall a. Eq a => a -> a -> Bool
/= BfsDistance
apartBfs
                      then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
acc2  -- the position visited already
                      else do
                        let alter :: Word8
                            !alter :: Word8
alter = Array Word8
lalter Array Word8 -> Int -> UnboxRep Word8
forall c. UnboxRepClass c => Array c -> Int -> UnboxRep c
`PointArray.accessI` Int
p
                        if | Word8
alterSkill Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
alter -> Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
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
                             Int -> BfsDistance -> ST s ()
unsafeWriteI Int
p BfsDistance
distCompl
                             Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
acc2
                           | Bool
otherwise -> do
                             Int -> BfsDistance -> ST s ()
unsafeWriteI Int
p BfsDistance
distance
                             Int -> Int -> ST s ()
unsafeWriteNext Int
acc2 Int
p
                             Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$! Int
acc2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                -- Innermost loop over @moves@ manually unrolled for (JS) speed:
                Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
acc1
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> ST s Int
processMove (-Int
1, -Int
1)
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> ST s Int
processMove (Int
0, -Int
1)
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> ST s Int
processMove (Int
1, -Int
1)
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> ST s Int
processMove (Int
1, Int
0)
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> ST s Int
processMove (Int
1, Int
1)
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> ST s Int
processMove (Int
0, Int
1)
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> ST s Int
processMove (-Int
1, Int
1)
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> ST s Int
processMove (-Int
1, Int
0)
                  -- Recursive call to process next queue element:
                  ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> ST s Int
processQueue (Int
currentQueueIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Int
acc3 <- Int -> Int -> ST s Int
processQueue (Int
prevQueueIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0
        let distanceNew :: BfsDistance
distanceNew = BfsDistance -> BfsDistance
succBfsDistance BfsDistance
distance
        if Int
acc3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| BfsDistance
distanceNew BfsDistance -> BfsDistance -> Bool
forall a. Eq a => a -> a -> Bool
== BfsDistance
maxBfsDistance
        then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- no more close enough dungeon positions
        else MutablePrimArray s Int
-> MutablePrimArray s Int -> BfsDistance -> Int -> ST s ()
bfs MutablePrimArray s Int
tabWriteThawed MutablePrimArray s Int
tabReadThawed BfsDistance
distanceNew Int
acc3
  MVector (PrimState (ST s)) DistanceWord
-> Int -> DistanceWord -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.unsafeWrite MVector s DistanceWord
MVector (PrimState (ST s)) DistanceWord
vThawed Int
sourceI (BfsDistance -> DistanceWord
bfsDistance BfsDistance
minKnownBfs)
  MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PA.writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
tabAThawed Int
0 Int
sourceI
  MutablePrimArray s Int
-> MutablePrimArray s Int -> BfsDistance -> Int -> ST s ()
bfs MutablePrimArray s Int
tabAThawed MutablePrimArray s Int
tabBThawed (BfsDistance -> BfsDistance
succBfsDistance BfsDistance
minKnownBfs) Int
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 -> Int
pathLen    :: Int      -- needn't be @length pathList@
  }
  deriving (Int -> AndPath -> ShowS
[AndPath] -> ShowS
AndPath -> String
(Int -> AndPath -> ShowS)
-> (AndPath -> String) -> ([AndPath] -> ShowS) -> Show AndPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AndPath] -> ShowS
$cshowList :: [AndPath] -> ShowS
show :: AndPath -> String
$cshow :: AndPath -> String
showsPrec :: Int -> AndPath -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep AndPath x -> AndPath
$cfrom :: forall x. AndPath -> Rep AndPath x
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
-> (Int -> Bool)
-> Point
-> Point
-> Int
-> Array BfsDistance
-> Maybe AndPath
findPathBfs EnumSet Point
lbig Array Word8
lalter Int -> Bool
fovLit Point
pathSource Point
pathGoal Int
sepsRaw Array BfsDistance
arr =
  let !pathGoalI :: Int
pathGoalI = Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
pathGoal
      !pathSourceI :: Int
pathSourceI = Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
pathSource
      eps :: Int
eps = Int
sepsRaw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4
      ([Int]
mc1, [Int]
mc2) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
eps [Int]
movesCardinalI
      ([Int]
md1, [Int]
md2) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
eps [Int]
movesDiagonalI
      -- Prefer cardinal directions when closer to the target, so that
      -- the enemy can't easily disengage.
      prefMoves :: [Int]
prefMoves = [Int]
mc2 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
mc1 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
md2 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
md1  -- fuzz
      track :: PointI -> BfsDistance -> [Point] -> [Point]
      track :: Int -> BfsDistance -> [Point] -> [Point]
track !Int
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 (Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pathSourceI) [Point]
suffix
      track Int
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 = Int -> Point
forall a. Enum a => Int -> a
toEnum Int
pos
        in Point
posP Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
suffix  -- avoid calculating minP and dist for the last call
      track Int
pos BfsDistance
oldDist [Point]
suffix =
        let !dist :: BfsDistance
dist = BfsDistance -> BfsDistance
predBfsDistance BfsDistance
oldDist
            minChild :: PointI -> Bool -> Word8 -> [VectorI] -> PointI
            minChild :: Int -> Bool -> Word8 -> [Int] -> Int
minChild !Int
minP Bool
_ Word8
_ [] = Int
minP
            minChild Int
minP Bool
maxDark Word8
minAlter (Int
mv : [Int]
mvs) =
              let !p :: Int
p = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mv
                  backtrackingMove :: Bool
backtrackingMove =
                    DistanceWord -> BfsDistance
BfsDistance (Array BfsDistance
arr Array BfsDistance -> Int -> UnboxRep BfsDistance
forall c. UnboxRepClass c => Array c -> Int -> UnboxRep c
`PointArray.accessI` Int
p) BfsDistance -> BfsDistance -> Bool
forall a. Eq a => a -> a -> Bool
/= BfsDistance
dist
              in if Bool
backtrackingMove
                 then Int -> Bool -> Word8 -> [Int] -> Int
minChild Int
minP Bool
maxDark Word8
minAlter [Int]
mvs
                 else let free :: Bool
free = Int
p Int -> IntSet -> Bool
`IS.notMember` EnumSet Point -> IntSet
forall k. EnumSet k -> IntSet
ES.enumSetToIntSet EnumSet Point
lbig
                          alter :: Word8
alter | Bool
free = Array Word8
lalter Array Word8 -> Int -> UnboxRep Word8
forall c. UnboxRepClass c => Array c -> Int -> UnboxRep c
`PointArray.accessI` Int
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
$ Int -> Bool
fovLit Int
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
alter Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
&& Bool
dark -> Int
p  -- speedup
                            | Word8
alter Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
minAlter -> Int -> Bool -> Word8 -> [Int] -> Int
minChild Int
p Bool
dark Word8
alter [Int]
mvs
                            | Bool
dark Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
> Bool
maxDark Bool -> Bool -> Bool
&& Word8
alter Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
minAlter ->
                              Int -> Bool -> Word8 -> [Int] -> Int
minChild Int
p Bool
dark Word8
alter [Int]
mvs
                            | Bool
otherwise -> Int -> Bool -> Word8 -> [Int] -> Int
minChild Int
minP Bool
maxDark Word8
minAlter [Int]
mvs
            -- @maxBound@ means not alterable, so some child will be lower
            !newPos :: Int
newPos = Int -> Bool -> Word8 -> [Int] -> Int
minChild Int
pos{-dummy-} Bool
False Word8
forall a. Bounded a => a
maxBound [Int]
prefMoves
#ifdef WITH_EXPENSIVE_ASSERTIONS
            !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
pos) ()
#endif
            !posP :: Point
posP = Int -> Point
forall a. Enum a => Int -> a
toEnum Int
pos
        in Int -> BfsDistance -> [Point] -> [Point]
track Int
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 -> Int -> UnboxRep BfsDistance
forall c. UnboxRepClass c => Array c -> Int -> UnboxRep c
`PointArray.accessI` Int
pathGoalI
      pathLen :: Int
pathLen = DistanceWord -> Int
forall a. Enum a => a -> Int
fromEnum (DistanceWord -> Int) -> DistanceWord -> Int
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 = Int -> BfsDistance -> [Point] -> [Point]
track Int
pathGoalI (BfsDistance
goalDist BfsDistance -> BfsDistance -> BfsDistance
forall a. Bits a => a -> a -> a
.|. BfsDistance
minKnownBfs) []
      andPath :: AndPath
andPath = AndPath :: Point -> [Point] -> Point -> Int -> AndPath
AndPath{Int
[Point]
Point
pathList :: [Point]
pathLen :: Int
pathGoal :: Point
pathSource :: Point
pathLen :: Int
pathGoal :: Point
pathList :: [Point]
pathSource :: Point
..}
  in Bool -> Maybe AndPath -> Maybe AndPath
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (DistanceWord -> BfsDistance
BfsDistance (Array BfsDistance
arr Array BfsDistance -> Int -> UnboxRep BfsDistance
forall c. UnboxRepClass c => Array c -> Int -> UnboxRep c
`PointArray.accessI` Int
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
&& Int
pathLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Point -> Point -> Int
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, Int, Int, Int)
-> Point -> BfsDistance -> (Point, Int, Int, Int)
f acc :: (Point, Int, Int, Int)
acc@(Point
pAcc, Int
dAcc, Int
chessAcc, Int
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 :: Int
dist = DistanceWord -> Int
forall a. Enum a => a -> Int
fromEnum (DistanceWord -> Int) -> DistanceWord -> Int
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 :: Int
chessNew = Point -> Point -> Int
chessDist Point
p Point
pathGoal
                         sumNew :: Int
sumNew = Int
dist Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
chessNew
                         resNew :: (Point, Int, Int, Int)
resNew = (Point
p, Int
dist, Int
chessNew, Int
sumNew)
                     in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
sumNew Int
sumAcc of
                       Ordering
LT -> (Point, Int, Int, Int)
resNew
                       Ordering
EQ -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
chessNew Int
chessAcc of
                         Ordering
LT -> (Point, Int, Int, Int)
resNew
                         Ordering
EQ -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
dist Int
dAcc of
                           Ordering
LT -> (Point, Int, Int, Int)
resNew
                           Ordering
EQ | Point -> Point -> Int
euclidDistSq Point
p Point
pathGoal
                                Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Point -> Point -> Int
euclidDistSq Point
pAcc Point
pathGoal -> (Point, Int, Int, Int)
resNew
                           Ordering
_ -> (Point, Int, Int, Int)
acc
                         Ordering
_ -> (Point, Int, Int, Int)
acc
                       Ordering
_ -> (Point, Int, Int, Int)
acc
                else (Point, Int, Int, Int)
acc
              initAcc :: (Point, Int, Int, Int)
initAcc = (Point
originPoint, Int
forall a. Bounded a => a
maxBound, Int
forall a. Bounded a => a
maxBound, Int
forall a. Bounded a => a
maxBound)
              (Point
pRes, Int
dRes, Int
_, Int
sumRes) = ((Point, Int, Int, Int)
 -> Point -> BfsDistance -> (Point, Int, Int, Int))
-> (Point, Int, Int, Int)
-> Array BfsDistance
-> (Point, Int, Int, Int)
forall c a.
UnboxRepClass c =>
(a -> Point -> c -> a) -> a -> Array c -> a
PointArray.ifoldlA' (Point, Int, Int, Int)
-> Point -> BfsDistance -> (Point, Int, Int, Int)
f (Point, Int, Int, Int)
initAcc Array BfsDistance
arr
          in if Int
sumRes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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
&& Int
pathLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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 =
                        Int -> BfsDistance -> [Point] -> [Point]
track (Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
pRes)
                              (DistanceWord -> BfsDistance
BfsDistance (Int -> DistanceWord
forall a. Enum a => Int -> a
toEnum Int
dRes) BfsDistance -> BfsDistance -> BfsDistance
forall a. Bits a => a -> a -> a
.|. BfsDistance
minKnownBfs) []
                  in AndPath -> Maybe AndPath
forall a. a -> Maybe a
Just AndPath :: Point -> [Point] -> Point -> Int -> AndPath
AndPath{pathList :: [Point]
pathList = [Point]
pathList2, pathLen :: Int
pathLen = Int
sumRes, Point
pathGoal :: Point
pathSource :: Point
pathGoal :: Point
pathSource :: Point
..}

-- | Access a BFS array and interpret the looked up distance value.
accessBfs :: PointArray.Array BfsDistance -> Point -> Maybe Int
accessBfs :: Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
p = if Array BfsDistance -> Int
forall c. Array c -> Int
PointArray.axsize Array BfsDistance
bfs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                  then Maybe Int
forall a. Maybe a
Nothing
                  else BfsDistance -> Maybe Int
distanceBfs (BfsDistance -> Maybe Int) -> BfsDistance -> Maybe Int
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 Int
distanceBfs BfsDistance
dist = if BfsDistance
dist BfsDistance -> BfsDistance -> Bool
forall a. Eq a => a -> a -> Bool
== BfsDistance
apartBfs
                   then Maybe Int
forall a. Maybe a
Nothing
                   else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ DistanceWord -> Int
forall a. Enum a => a -> Int
fromEnum (DistanceWord -> Int) -> DistanceWord -> Int
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