-- | Inhabited dungeon levels and the operations to query and change them
-- as the game progresses.
module Game.LambdaHack.Common.Level
  ( -- * Dungeon
    Dungeon, dungeonBounds, ascendInBranch, whereTo
    -- * The @Level@ type and its components
  , ItemFloor, BigActorMap, ProjectileMap, TileMap, SmellMap, Level(..)
    -- * Component updates
  , updateFloor, updateEmbed, updateBigMap, updateProjMap
  , updateTile, updateEntry, updateSmell
    -- * Level query
  , at
  , posToBigLvl, occupiedBigLvl, posToProjsLvl, occupiedProjLvl, posToAidsLvl
  , findPosTry, findPosTry2, nearbyPassablePoints, nearbyFreePoints
    -- * Misc
  , sortEmbeds
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , EntryMap
  , assertSparseItems, assertSparseProjectiles
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES

import           Game.LambdaHack.Common.Area
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Content.CaveKind (CaveKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.PlaceKind
import           Game.LambdaHack.Content.RuleKind
import           Game.LambdaHack.Content.TileKind (TileKind)
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Random
import           Game.LambdaHack.Definition.Defs

-- | The complete dungeon is a map from level identifiers to levels.
type Dungeon = EM.EnumMap LevelId Level

dungeonBounds :: Dungeon -> (LevelId, LevelId)
dungeonBounds :: Dungeon -> (LevelId, LevelId)
dungeonBounds Dungeon
dungeon
  | Just ((LevelId
s, Level
_), Dungeon
_) <- Dungeon -> Maybe ((LevelId, Level), Dungeon)
forall k a. Enum k => EnumMap k a -> Maybe ((k, a), EnumMap k a)
EM.minViewWithKey Dungeon
dungeon
  , Just ((LevelId
e, Level
_), Dungeon
_) <- Dungeon -> Maybe ((LevelId, Level), Dungeon)
forall k a. Enum k => EnumMap k a -> Maybe ((k, a), EnumMap k a)
EM.maxViewWithKey Dungeon
dungeon
  = (LevelId
s, LevelId
e)
dungeonBounds Dungeon
dungeon = [Char] -> (LevelId, LevelId)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (LevelId, LevelId)) -> [Char] -> (LevelId, LevelId)
forall a b. (a -> b) -> a -> b
$ [Char]
"empty dungeon" [Char] -> Dungeon -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Dungeon
dungeon

-- | Levels in the current branch, one level up (or down) from the current.
ascendInBranch :: Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch :: Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up LevelId
lid =
  -- Currently there is just one branch, so the computation is simple.
  let (LevelId
minD, LevelId
maxD) = Dungeon -> (LevelId, LevelId)
dungeonBounds Dungeon
dungeon
      ln :: LevelId
ln = LevelId -> LevelId -> LevelId
forall a. Ord a => a -> a -> a
max LevelId
minD (LevelId -> LevelId) -> LevelId -> LevelId
forall a b. (a -> b) -> a -> b
$ LevelId -> LevelId -> LevelId
forall a. Ord a => a -> a -> a
min LevelId
maxD (LevelId -> LevelId) -> LevelId -> LevelId
forall a b. (a -> b) -> a -> b
$ Int -> LevelId
forall a. Enum a => Int -> a
toEnum (Int -> LevelId) -> Int -> LevelId
forall a b. (a -> b) -> a -> b
$ LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
lid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Bool
up then Int
1 else -Int
1
  in case LevelId -> Dungeon -> Maybe Level
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup LevelId
ln Dungeon
dungeon of
    Just Level
_ | LevelId
ln LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
lid -> [LevelId
ln]
    Maybe Level
_ | LevelId
ln LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid -> []
    Maybe Level
_ -> Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up LevelId
ln  -- jump over gaps

-- | Compute the level identifier and stair position on the new level,
-- after a level change.
--
-- We assume there is never a staircase up and down at the same position.
whereTo :: LevelId             -- ^ level of the stairs
        -> Point               -- ^ position of the stairs
        -> Bool                -- ^ optional forced direction
        -> Dungeon             -- ^ current game dungeon
        -> [(LevelId, Point)]  -- ^ possible destinations
whereTo :: LevelId -> Point -> Bool -> Dungeon -> [(LevelId, Point)]
whereTo LevelId
lid Point
pos Bool
up Dungeon
dungeon =
  let lvl :: Level
lvl = Dungeon
dungeon Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
      li :: [Int]
li = case Point -> [Point] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Point
pos ([Point] -> Maybe Int) -> [Point] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ([Point], [Point]) -> [Point]
forall a b. (a, b) -> a
fst (([Point], [Point]) -> [Point]) -> ([Point], [Point]) -> [Point]
forall a b. (a -> b) -> a -> b
$ Level -> ([Point], [Point])
lstair Level
lvl of
        Just Int
ifst -> Bool -> [Int] -> [Int]
forall a. HasCallStack => Bool -> a -> a
assert Bool
up [Int
ifst]
        Maybe Int
Nothing -> case Point -> [Point] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Point
pos ([Point] -> Maybe Int) -> [Point] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ([Point], [Point]) -> [Point]
forall a b. (a, b) -> b
snd (([Point], [Point]) -> [Point]) -> ([Point], [Point]) -> [Point]
forall a b. (a -> b) -> a -> b
$ Level -> ([Point], [Point])
lstair Level
lvl of
          Just Int
isnd -> Bool -> [Int] -> [Int]
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not Bool
up) [Int
isnd]
          Maybe Int
Nothing ->
            let forcedPoss :: [Point]
forcedPoss = (if Bool
up then ([Point], [Point]) -> [Point]
forall a b. (a, b) -> a
fst else ([Point], [Point]) -> [Point]
forall a b. (a, b) -> b
snd) (Level -> ([Point], [Point])
lstair Level
lvl)
            in [Int
0 .. [Point] -> Int
forall a. [a] -> Int
length [Point]
forcedPoss Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]  -- for ascending via, e.g., spells
  in case Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up LevelId
lid of
    [] -> []  -- spell fizzles
    LevelId
ln : [LevelId]
_ -> let lvlDest :: Level
lvlDest = Dungeon
dungeon Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
ln
                  stairsDest :: [Point]
stairsDest = (if Bool
up then ([Point], [Point]) -> [Point]
forall a b. (a, b) -> b
snd else ([Point], [Point]) -> [Point]
forall a b. (a, b) -> a
fst) (Level -> ([Point], [Point])
lstair Level
lvlDest)
                  posAtIndex :: Int -> (LevelId, Point)
posAtIndex Int
i = case Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop Int
i [Point]
stairsDest of
                    [] -> [Char] -> (LevelId, Point)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (LevelId, Point)) -> [Char] -> (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ [Char]
"not enough stairs:" [Char] -> (LevelId, Int) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (LevelId
ln, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    Point
p : [Point]
_ -> (LevelId
ln, Point
p)
              in (Int -> (LevelId, Point)) -> [Int] -> [(LevelId, Point)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (LevelId, Point)
posAtIndex [Int]
li

-- | Items located on map tiles.
type ItemFloor = EM.EnumMap Point ItemBag

-- | Big actors located on map tiles.
type BigActorMap = EM.EnumMap Point ActorId

-- | Collections of projectiles located on map tiles.
type ProjectileMap = EM.EnumMap Point [ActorId]

-- | Tile kinds on the map.
type TileMap = PointArray.Array (ContentId TileKind)

-- | Current smell on map tiles.
type SmellMap = EM.EnumMap Point Time

-- | Entries of places on the map.
type EntryMap = EM.EnumMap Point PlaceEntry

-- | A view on single, inhabited dungeon level. "Remembered" fields
-- carry a subset of the info in the client copies of levels.
data Level = Level
  { Level -> ContentId CaveKind
lkind   :: ContentId CaveKind
                          -- ^ the kind of cave the level is an instance of
  , Level -> AbsDepth
ldepth  :: Dice.AbsDepth
                          -- ^ absolute depth of the level
  , Level -> ItemFloor
lfloor  :: ItemFloor  -- ^ remembered items lying on the floor
  , Level -> ItemFloor
lembed  :: ItemFloor  -- ^ remembered items embedded in the tile
  , Level -> BigActorMap
lbig    :: BigActorMap
                          -- ^ seen big (non-projectile) actors at positions
                          --   on the level;
                          --   could be recomputed at resume, but small enough
  , Level -> ProjectileMap
lproj   :: ProjectileMap
                          -- ^ seen projectiles at positions on the level;
                          --   could be recomputed at resume
  , Level -> TileMap
ltile   :: TileMap    -- ^ remembered level map
  , Level -> EntryMap
lentry  :: EntryMap   -- ^ room entrances on the level
  , Level -> Area
larea   :: Area       -- ^ area of the level
  , Level -> SmellMap
lsmell  :: SmellMap   -- ^ remembered smells on the level
  , Level -> ([Point], [Point])
lstair  :: ([Point], [Point])
                          -- ^ positions of (up, down) stairs
  , Level -> [Point]
lescape :: [Point]    -- ^ positions of IK.Escape tiles
  , Level -> Int
lseen   :: Int        -- ^ currently remembered clear tiles
  , Level -> Int
lexpl   :: Int        -- ^ total number of explorable tiles
  , Level -> Time
ltime   :: Time       -- ^ local time on the level (possibly frozen)
  , Level -> Bool
lnight  :: Bool       -- ^ whether the level is covered in darkness
  }
  deriving (Int -> Level -> ShowS
[Level] -> ShowS
Level -> [Char]
(Int -> Level -> ShowS)
-> (Level -> [Char]) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> [Char]
$cshow :: Level -> [Char]
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show, Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq)

assertSparseItems :: ItemFloor -> ItemFloor
assertSparseItems :: ItemFloor -> ItemFloor
assertSparseItems ItemFloor
m =
  Bool -> ItemFloor -> ItemFloor
forall a. HasCallStack => Bool -> a -> a
assert (ItemFloor -> Bool
forall k a. EnumMap k a -> Bool
EM.null ((EnumMap ItemId ItemQuant -> Bool) -> ItemFloor -> ItemFloor
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter EnumMap ItemId ItemQuant -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemFloor
m)
          Bool -> ([Char], ItemFloor) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"null floors found" [Char] -> ItemFloor -> ([Char], ItemFloor)
forall v. [Char] -> v -> ([Char], v)
`swith` ItemFloor
m) ItemFloor
m

hashConsSingle :: ItemFloor -> ItemFloor
hashConsSingle :: ItemFloor -> ItemFloor
hashConsSingle =
  (EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant)
-> ItemFloor -> ItemFloor
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map ((ItemQuant -> ItemQuant)
-> EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\case
                    (Int
1, []) -> ItemQuant
quantSingle
                    ItemQuant
kit -> ItemQuant
kit))

assertSparseProjectiles :: ProjectileMap -> ProjectileMap
assertSparseProjectiles :: ProjectileMap -> ProjectileMap
assertSparseProjectiles ProjectileMap
m =
  Bool -> ProjectileMap -> ProjectileMap
forall a. HasCallStack => Bool -> a -> a
assert (ProjectileMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null (([ActorId] -> Bool) -> ProjectileMap -> ProjectileMap
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter [ActorId] -> Bool
forall a. [a] -> Bool
null ProjectileMap
m)
          Bool -> ([Char], ProjectileMap) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"null projectile lists found" [Char] -> ProjectileMap -> ([Char], ProjectileMap)
forall v. [Char] -> v -> ([Char], v)
`swith` ProjectileMap
m) ProjectileMap
m

updateFloor :: (ItemFloor -> ItemFloor) -> Level -> Level
{-# INLINE updateFloor #-}  -- just in case inliner goes hiwire
updateFloor :: (ItemFloor -> ItemFloor) -> Level -> Level
updateFloor ItemFloor -> ItemFloor
f Level
lvl = Level
lvl {lfloor :: ItemFloor
lfloor = ItemFloor -> ItemFloor
f (Level -> ItemFloor
lfloor Level
lvl)}

updateEmbed :: (ItemFloor -> ItemFloor) -> Level -> Level
updateEmbed :: (ItemFloor -> ItemFloor) -> Level -> Level
updateEmbed ItemFloor -> ItemFloor
f Level
lvl = Level
lvl {lembed :: ItemFloor
lembed = ItemFloor -> ItemFloor
f (Level -> ItemFloor
lembed Level
lvl)}

updateBigMap :: (BigActorMap -> BigActorMap) -> Level -> Level
updateBigMap :: (BigActorMap -> BigActorMap) -> Level -> Level
updateBigMap BigActorMap -> BigActorMap
f Level
lvl = Level
lvl {lbig :: BigActorMap
lbig = BigActorMap -> BigActorMap
f (Level -> BigActorMap
lbig Level
lvl)}

updateProjMap :: (ProjectileMap -> ProjectileMap) -> Level -> Level
{-# INLINE updateProjMap #-}
updateProjMap :: (ProjectileMap -> ProjectileMap) -> Level -> Level
updateProjMap ProjectileMap -> ProjectileMap
f Level
lvl = Level
lvl {lproj :: ProjectileMap
lproj = ProjectileMap -> ProjectileMap
f (Level -> ProjectileMap
lproj Level
lvl)}

updateTile :: (TileMap -> TileMap) -> Level -> Level
updateTile :: (TileMap -> TileMap) -> Level -> Level
updateTile TileMap -> TileMap
f Level
lvl = Level
lvl {ltile :: TileMap
ltile = TileMap -> TileMap
f (Level -> TileMap
ltile Level
lvl)}

updateEntry :: (EntryMap -> EntryMap) -> Level -> Level
updateEntry :: (EntryMap -> EntryMap) -> Level -> Level
updateEntry EntryMap -> EntryMap
f Level
lvl = Level
lvl {lentry :: EntryMap
lentry = EntryMap -> EntryMap
f (Level -> EntryMap
lentry Level
lvl)}

updateSmell :: (SmellMap -> SmellMap) -> Level -> Level
updateSmell :: (SmellMap -> SmellMap) -> Level -> Level
updateSmell SmellMap -> SmellMap
f Level
lvl = Level
lvl {lsmell :: SmellMap
lsmell = SmellMap -> SmellMap
f (Level -> SmellMap
lsmell Level
lvl)}

-- | Query for tile kinds on the map.
at :: Level -> Point -> ContentId TileKind
{-# INLINE at #-}
at :: Level -> Point -> ContentId TileKind
at Level{TileMap
ltile :: TileMap
ltile :: Level -> TileMap
ltile} Point
p = TileMap
ltile TileMap -> Point -> ContentId TileKind
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
p

posToBigLvl :: Point -> Level -> Maybe ActorId
{-# INLINE posToBigLvl #-}
posToBigLvl :: Point -> Level -> Maybe ActorId
posToBigLvl Point
pos Level
lvl = Point -> BigActorMap -> Maybe ActorId
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
pos (BigActorMap -> Maybe ActorId) -> BigActorMap -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ Level -> BigActorMap
lbig Level
lvl

occupiedBigLvl :: Point -> Level -> Bool
{-# INLINE occupiedBigLvl #-}
occupiedBigLvl :: Point -> Level -> Bool
occupiedBigLvl Point
pos Level
lvl = Point
pos Point -> BigActorMap -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Level -> BigActorMap
lbig Level
lvl

posToProjsLvl :: Point -> Level -> [ActorId]
{-# INLINE posToProjsLvl #-}
posToProjsLvl :: Point -> Level -> [ActorId]
posToProjsLvl Point
pos Level
lvl = [ActorId] -> Point -> ProjectileMap -> [ActorId]
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault [] Point
pos (ProjectileMap -> [ActorId]) -> ProjectileMap -> [ActorId]
forall a b. (a -> b) -> a -> b
$ Level -> ProjectileMap
lproj Level
lvl

occupiedProjLvl :: Point -> Level -> Bool
{-# INLINE occupiedProjLvl #-}
occupiedProjLvl :: Point -> Level -> Bool
occupiedProjLvl Point
pos Level
lvl = Point
pos Point -> ProjectileMap -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Level -> ProjectileMap
lproj Level
lvl

posToAidsLvl :: Point -> Level -> [ActorId]
{-# INLINE posToAidsLvl #-}
posToAidsLvl :: Point -> Level -> [ActorId]
posToAidsLvl Point
pos Level
lvl = Maybe ActorId -> [ActorId]
forall a. Maybe a -> [a]
maybeToList (Point -> Level -> Maybe ActorId
posToBigLvl Point
pos Level
lvl)
                       [ActorId] -> [ActorId] -> [ActorId]
forall a. [a] -> [a] -> [a]
++ Point -> Level -> [ActorId]
posToProjsLvl Point
pos Level
lvl

-- | Try to find a random position on the map satisfying
-- conjunction of the mandatory and an optional predicate.
-- If the permitted number of attempts is not enough,
-- try again the same number of times without the next optional predicate,
-- and fall back to trying with only the mandatory predicate.
findPosTry :: Int                                    -- ^ the number of tries
           -> Level                                  -- ^ look up in this level
           -> (Point -> ContentId TileKind -> Bool)  -- ^ mandatory predicate
           -> [Point -> ContentId TileKind -> Bool]  -- ^ optional predicates
           -> Rnd (Maybe Point)
{-# INLINE findPosTry #-}
findPosTry :: Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
findPosTry Int
numTries Level
lvl Point -> ContentId TileKind -> Bool
m = Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
findPosTry2 Int
numTries Level
lvl Point -> ContentId TileKind -> Bool
m [] Point -> ContentId TileKind -> Bool
forall a. HasCallStack => a
undefined

findPosTry2 :: Int                                    -- ^ the number of tries
            -> Level                                  -- ^ look up in this level
            -> (Point -> ContentId TileKind -> Bool)  -- ^ mandatory predicate
            -> [Point -> ContentId TileKind -> Bool]  -- ^ optional predicates
            -> (Point -> ContentId TileKind -> Bool)  -- ^ good to have pred.
            -> [Point -> ContentId TileKind -> Bool]  -- ^ worst case predicates
            -> Rnd (Maybe Point)
{-# INLINE findPosTry2 #-}
findPosTry2 :: Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
findPosTry2 Int
numTries Level{TileMap
ltile :: TileMap
ltile :: Level -> TileMap
ltile, Area
larea :: Area
larea :: Level -> Area
larea} Point -> ContentId TileKind -> Bool
m0 [Point -> ContentId TileKind -> Bool]
l Point -> ContentId TileKind -> Bool
g [Point -> ContentId TileKind -> Bool]
r =
  Bool -> Rnd (Maybe Point) -> Rnd (Maybe Point)
forall a. HasCallStack => Bool -> a -> a
assert (Int
numTries Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Rnd (Maybe Point) -> Rnd (Maybe Point))
-> Rnd (Maybe Point) -> Rnd (Maybe Point)
forall a b. (a -> b) -> a -> b
$
  let (Point Int
x0 Int
y0, Int
xspan, Int
yspan) = Area -> (Point, Int, Int)
spanArea Area
larea
      accomodate :: Rnd (Maybe Point)
                 -> (Point -> ContentId TileKind -> Bool)
                 -> [Point -> ContentId TileKind -> Bool]
                 -> Rnd (Maybe Point)
      {-# INLINE accomodate #-}
      accomodate :: Rnd (Maybe Point)
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
accomodate Rnd (Maybe Point)
fallback Point -> ContentId TileKind -> Bool
m = [Point -> ContentId TileKind -> Bool] -> Rnd (Maybe Point)
go
       where
        go :: [Point -> ContentId TileKind -> Bool]
           -> Rnd (Maybe Point)
        go :: [Point -> ContentId TileKind -> Bool] -> Rnd (Maybe Point)
go [] = Rnd (Maybe Point)
fallback
        go (Point -> ContentId TileKind -> Bool
hd : [Point -> ContentId TileKind -> Bool]
tl) = Int -> Rnd (Maybe Point)
search Int
numTries
         where
          search :: Int -> Rnd (Maybe Point)
search Int
0 = [Point -> ContentId TileKind -> Bool] -> Rnd (Maybe Point)
go [Point -> ContentId TileKind -> Bool]
tl
          search !Int
k = do
            Int
pxyRelative <- Int -> Rnd Int
forall a. Integral a => a -> Rnd a
randomR0 (Int
xspan Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
yspan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            -- Here we can't use @fromEnum@ and/or work with the @Int@
            -- representation, because the span is different than @rWidthMax@.
            let Point{Int
py :: Point -> Int
px :: Point -> Int
py :: Int
px :: Int
..} = Int -> Int -> Point
punindex Int
xspan Int
pxyRelative
                pos :: Point
pos = Int -> Int -> Point
Point (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
px) (Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
py)
                tile :: ContentId TileKind
tile = TileMap
ltile TileMap -> Point -> ContentId TileKind
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
pos
            if Point -> ContentId TileKind -> Bool
m Point
pos ContentId TileKind
tile Bool -> Bool -> Bool
&& Point -> ContentId TileKind -> Bool
hd Point
pos ContentId TileKind
tile
            then Maybe Point -> Rnd (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Point -> Rnd (Maybe Point))
-> Maybe Point -> Rnd (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just Point
pos
            else Int -> Rnd (Maybe Point)
search (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      rAndOnceOnlym0 :: [Point -> ContentId TileKind -> Bool]
rAndOnceOnlym0 = [Point -> ContentId TileKind -> Bool]
r [Point -> ContentId TileKind -> Bool]
-> [Point -> ContentId TileKind -> Bool]
-> [Point -> ContentId TileKind -> Bool]
forall a. [a] -> [a] -> [a]
++ [\Point
_ ContentId TileKind
_ -> Bool
True]
  in Rnd (Maybe Point)
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
accomodate (Rnd (Maybe Point)
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
accomodate (Maybe Point -> Rnd (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing) Point -> ContentId TileKind -> Bool
m0 [Point -> ContentId TileKind -> Bool]
rAndOnceOnlym0)
                -- @pos@ and @tile@ not always needed, so not strict;
                -- the function arguments determine that thanks to inlining.
                (\Point
pos ContentId TileKind
tile -> Point -> ContentId TileKind -> Bool
m0 Point
pos ContentId TileKind
tile Bool -> Bool -> Bool
&& Point -> ContentId TileKind -> Bool
g Point
pos ContentId TileKind
tile)
                [Point -> ContentId TileKind -> Bool]
l

-- | Generate a list of all passable points on (connected component of)
-- the level in the order of path distance from the starting position (BFS).
-- The starting position needn't be passable and is always included.
nearbyPassablePoints :: COps -> Level -> Point -> [Point]
nearbyPassablePoints :: COps -> Level -> Point -> [Point]
nearbyPassablePoints cops :: COps
cops@COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: RuleContent -> Int
rWidthMax :: Int
rWidthMax, Int
rHeightMax :: RuleContent -> Int
rHeightMax :: Int
rHeightMax}}
                     Level
lvl Point
start =
  let passable :: Point -> Bool
passable Point
p = TileSpeedup -> ContentId TileKind -> Bool
Tile.isEasyOpen (COps -> TileSpeedup
coTileSpeedup COps
cops) (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
      -- The error is mostly probably caused by place content creating
      -- enclosed spaces in conjunction with map edges. To verify,
      -- change the error to @l@ and run with the same seed.
      semiRandomWrap :: [Point] -> [Point]
semiRandomWrap [Point]
l = if [Point] -> Bool
forall a. [a] -> Bool
null [Point]
l then [Char] -> [Point]
forall a. HasCallStack => [Char] -> a
error [Char]
"nearbyPassablePoints: blocked"
                         else let offset :: Int
offset = Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
start Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [Point] -> Int
forall a. [a] -> Int
length [Point]
l
                              in Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop Int
offset [Point]
l [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
offset [Point]
l
      passableVic :: Point -> [Point]
passableVic Point
p = [Point] -> [Point]
semiRandomWrap ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter Point -> Bool
passable
                      ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Point -> [Point]
vicinityBounded Int
rWidthMax Int
rHeightMax Point
p
      siftSingle :: Point
                 -> (ES.EnumSet Point, [Point])
                 -> (ES.EnumSet Point, [Point])
      siftSingle :: Point -> (EnumSet Point, [Point]) -> (EnumSet Point, [Point])
siftSingle Point
current (EnumSet Point
seen, [Point]
sameDistance) =
        if Point
current Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet Point
seen
        then (EnumSet Point
seen, [Point]
sameDistance)
        else (Point -> EnumSet Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert Point
current EnumSet Point
seen, Point
current Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
sameDistance)
      siftVicinity :: Point
                   -> (ES.EnumSet Point, [Point])
                   -> (ES.EnumSet Point, [Point])
      siftVicinity :: Point -> (EnumSet Point, [Point]) -> (EnumSet Point, [Point])
siftVicinity Point
current (EnumSet Point, [Point])
seenAndSameDistance =
        let vic :: [Point]
vic = Point -> [Point]
passableVic Point
current
        in (Point -> (EnumSet Point, [Point]) -> (EnumSet Point, [Point]))
-> (EnumSet Point, [Point]) -> [Point] -> (EnumSet Point, [Point])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Point -> (EnumSet Point, [Point]) -> (EnumSet Point, [Point])
siftSingle (EnumSet Point, [Point])
seenAndSameDistance [Point]
vic
      siftNearby :: (ES.EnumSet Point, [Point]) -> [Point]
      siftNearby :: (EnumSet Point, [Point]) -> [Point]
siftNearby (EnumSet Point
seen, [Point]
sameDistance) =
        [Point]
sameDistance
        [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ case (Point -> (EnumSet Point, [Point]) -> (EnumSet Point, [Point]))
-> (EnumSet Point, [Point]) -> [Point] -> (EnumSet Point, [Point])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Point -> (EnumSet Point, [Point]) -> (EnumSet Point, [Point])
siftVicinity (EnumSet Point
seen, []) [Point]
sameDistance of
             (EnumSet Point
_, []) -> []
             (EnumSet Point
seen2, [Point]
sameDistance2) -> (EnumSet Point, [Point]) -> [Point]
siftNearby (EnumSet Point
seen2, [Point]
sameDistance2)
  in (EnumSet Point, [Point]) -> [Point]
siftNearby (Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k
ES.singleton Point
start, [Point
start])

nearbyFreePoints :: COps -> Level -> (ContentId TileKind -> Bool) -> Point
                 -> [Point]
nearbyFreePoints :: COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point]
nearbyFreePoints COps
cops Level
lvl ContentId TileKind -> Bool
f Point
start =
  let good :: Point -> Bool
good Point
p = ContentId TileKind -> Bool
f (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
               Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable (COps -> TileSpeedup
coTileSpeedup COps
cops) (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
               Bool -> Bool -> Bool
&& [ActorId] -> Bool
forall a. [a] -> Bool
null (Point -> Level -> [ActorId]
posToAidsLvl Point
p Level
lvl)
  in (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter Point -> Bool
good ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ COps -> Level -> Point -> [Point]
nearbyPassablePoints COps
cops Level
lvl Point
start

-- We ignore stray embeds, not mentioned in the tile kind.
-- OTOH, some of those mentioned may be used up and so not in the bag
-- and it's OK.
sortEmbeds :: COps -> ContentId TileKind -> [(IK.ItemKind, (ItemId, ItemQuant))]
           -> [(ItemId, ItemQuant)]
sortEmbeds :: COps
-> ContentId TileKind
-> [(ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
sortEmbeds COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile} ContentId TileKind
tk [(ItemKind, (ItemId, ItemQuant))]
embedKindList =
  let grpList :: [GroupName ItemKind]
grpList = ContentData TileKind -> ContentId TileKind -> [GroupName ItemKind]
Tile.embeddedItems ContentData TileKind
cotile ContentId TileKind
tk
      -- Greater or equal 0 to also cover template UNKNOWN items
      -- not yet identified by the client.
      f :: GroupName ItemKind -> (ItemKind, b) -> Bool
f GroupName ItemKind
grp (ItemKind
itemKind, b
_) = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  in ((ItemKind, (ItemId, ItemQuant)) -> (ItemId, ItemQuant))
-> [(ItemKind, (ItemId, ItemQuant))] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map (ItemKind, (ItemId, ItemQuant)) -> (ItemId, ItemQuant)
forall a b. (a, b) -> b
snd ([(ItemKind, (ItemId, ItemQuant))] -> [(ItemId, ItemQuant)])
-> [(ItemKind, (ItemId, ItemQuant))] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ (GroupName ItemKind -> Maybe (ItemKind, (ItemId, ItemQuant)))
-> [GroupName ItemKind] -> [(ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\GroupName ItemKind
grp -> ((ItemKind, (ItemId, ItemQuant)) -> Bool)
-> [(ItemKind, (ItemId, ItemQuant))]
-> Maybe (ItemKind, (ItemId, ItemQuant))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (GroupName ItemKind -> (ItemKind, (ItemId, ItemQuant)) -> Bool
forall b. GroupName ItemKind -> (ItemKind, b) -> Bool
f GroupName ItemKind
grp) [(ItemKind, (ItemId, ItemQuant))]
embedKindList) [GroupName ItemKind]
grpList

instance Binary Level where
  put :: Level -> Put
put Level{Bool
Int
[Point]
([Point], [Point])
ProjectileMap
ItemFloor
SmellMap
BigActorMap
EntryMap
AbsDepth
Time
ContentId CaveKind
Area
TileMap
lnight :: Bool
ltime :: Time
lexpl :: Int
lseen :: Int
lescape :: [Point]
lstair :: ([Point], [Point])
lsmell :: SmellMap
larea :: Area
lentry :: EntryMap
ltile :: TileMap
lproj :: ProjectileMap
lbig :: BigActorMap
lembed :: ItemFloor
lfloor :: ItemFloor
ldepth :: AbsDepth
lkind :: ContentId CaveKind
lnight :: Level -> Bool
ltime :: Level -> Time
lexpl :: Level -> Int
lseen :: Level -> Int
lescape :: Level -> [Point]
lsmell :: Level -> SmellMap
larea :: Level -> Area
lentry :: Level -> EntryMap
ltile :: Level -> TileMap
lproj :: Level -> ProjectileMap
lbig :: Level -> BigActorMap
lembed :: Level -> ItemFloor
lfloor :: Level -> ItemFloor
ldepth :: Level -> AbsDepth
lkind :: Level -> ContentId CaveKind
lstair :: Level -> ([Point], [Point])
..} = do
    ContentId CaveKind -> Put
forall t. Binary t => t -> Put
put ContentId CaveKind
lkind
    AbsDepth -> Put
forall t. Binary t => t -> Put
put AbsDepth
ldepth
    ItemFloor -> Put
forall t. Binary t => t -> Put
put (ItemFloor -> ItemFloor
assertSparseItems ItemFloor
lfloor)
    ItemFloor -> Put
forall t. Binary t => t -> Put
put (ItemFloor -> ItemFloor
assertSparseItems ItemFloor
lembed)
    BigActorMap -> Put
forall t. Binary t => t -> Put
put BigActorMap
lbig
    ProjectileMap -> Put
forall t. Binary t => t -> Put
put (ProjectileMap -> ProjectileMap
assertSparseProjectiles ProjectileMap
lproj)
    TileMap -> Put
forall t. Binary t => t -> Put
put TileMap
ltile
    EntryMap -> Put
forall t. Binary t => t -> Put
put EntryMap
lentry
    Area -> Put
forall t. Binary t => t -> Put
put Area
larea
    SmellMap -> Put
forall t. Binary t => t -> Put
put SmellMap
lsmell
    ([Point], [Point]) -> Put
forall t. Binary t => t -> Put
put ([Point], [Point])
lstair
    [Point] -> Put
forall t. Binary t => t -> Put
put [Point]
lescape
    Int -> Put
forall t. Binary t => t -> Put
put Int
lseen
    Int -> Put
forall t. Binary t => t -> Put
put Int
lexpl
    Time -> Put
forall t. Binary t => t -> Put
put Time
ltime
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
lnight
  get :: Get Level
get = do
    ContentId CaveKind
lkind <- Get (ContentId CaveKind)
forall t. Binary t => Get t
get
    AbsDepth
ldepth <- Get AbsDepth
forall t. Binary t => Get t
get
    ItemFloor
lfloor <- ItemFloor -> ItemFloor
hashConsSingle (ItemFloor -> ItemFloor) -> Get ItemFloor -> Get ItemFloor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ItemFloor
forall t. Binary t => Get t
get
    ItemFloor
lembed <- ItemFloor -> ItemFloor
hashConsSingle (ItemFloor -> ItemFloor) -> Get ItemFloor -> Get ItemFloor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ItemFloor
forall t. Binary t => Get t
get
    BigActorMap
lbig <- Get BigActorMap
forall t. Binary t => Get t
get
    ProjectileMap
lproj <- Get ProjectileMap
forall t. Binary t => Get t
get
    TileMap
ltile <- Get TileMap
forall t. Binary t => Get t
get
    EntryMap
lentry <- Get EntryMap
forall t. Binary t => Get t
get
    Area
larea <- Get Area
forall t. Binary t => Get t
get
    SmellMap
lsmell <- Get SmellMap
forall t. Binary t => Get t
get
    ([Point], [Point])
lstair <- Get ([Point], [Point])
forall t. Binary t => Get t
get
    [Point]
lescape <- Get [Point]
forall t. Binary t => Get t
get
    Int
lseen <- Get Int
forall t. Binary t => Get t
get
    Int
lexpl <- Get Int
forall t. Binary t => Get t
get
    Time
ltime <- Get Time
forall t. Binary t => Get t
get
    Bool
lnight <- Get Bool
forall t. Binary t => Get t
get
    Level -> Get Level
forall (m :: * -> *) a. Monad m => a -> m a
return (Level -> Get Level) -> Level -> Get Level
forall a b. (a -> b) -> a -> b
$! Level :: ContentId CaveKind
-> AbsDepth
-> ItemFloor
-> ItemFloor
-> BigActorMap
-> ProjectileMap
-> TileMap
-> EntryMap
-> Area
-> SmellMap
-> ([Point], [Point])
-> [Point]
-> Int
-> Int
-> Time
-> Bool
-> Level
Level{Bool
Int
[Point]
([Point], [Point])
ProjectileMap
ItemFloor
SmellMap
BigActorMap
EntryMap
AbsDepth
Time
ContentId CaveKind
Area
TileMap
lnight :: Bool
ltime :: Time
lexpl :: Int
lseen :: Int
lescape :: [Point]
lstair :: ([Point], [Point])
lsmell :: SmellMap
larea :: Area
lentry :: EntryMap
ltile :: TileMap
lproj :: ProjectileMap
lbig :: BigActorMap
lembed :: ItemFloor
lfloor :: ItemFloor
ldepth :: AbsDepth
lkind :: ContentId CaveKind
lnight :: Bool
ltime :: Time
lexpl :: Int
lseen :: Int
lescape :: [Point]
lsmell :: SmellMap
larea :: Area
lentry :: EntryMap
ltile :: TileMap
lproj :: ProjectileMap
lbig :: BigActorMap
lembed :: ItemFloor
lfloor :: ItemFloor
ldepth :: AbsDepth
lkind :: ContentId CaveKind
lstair :: ([Point], [Point])
..}