module Game.LambdaHack.Common.Level
(
Dungeon, dungeonBounds, ascendInBranch, whereTo
, ItemFloor, BigActorMap, ProjectileMap, TileMap, SmellMap, Level(..)
, updateFloor, updateEmbed, updateBigMap, updateProjMap
, updateTile, updateEntry, updateSmell
, at
, posToBigLvl, occupiedBigLvl, posToProjsLvl, occupiedProjLvl, posToAidsLvl
, findPosTry, findPosTry2, nearbyPassablePoints, nearbyFreePoints
, sortEmbeds
#ifdef EXPOSE_INTERNAL
, 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
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 = String -> (LevelId, LevelId)
forall a. (?callStack::CallStack) => String -> a
error (String -> (LevelId, LevelId)) -> String -> (LevelId, LevelId)
forall a b. (a -> b) -> a -> b
$ String
"empty dungeon" String -> Dungeon -> String
forall v. Show v => String -> v -> String
`showFailure` Dungeon
dungeon
ascendInBranch :: Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch :: Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up LevelId
lid =
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
whereTo :: LevelId
-> Point
-> Bool
-> Dungeon
-> [(LevelId, Point)]
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. (?callStack::CallStack) => 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. (?callStack::CallStack) => 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]
in case Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up LevelId
lid of
[] -> []
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
[] -> String -> (LevelId, Point)
forall a. (?callStack::CallStack) => String -> a
error (String -> (LevelId, Point)) -> String -> (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ String
"not enough stairs:" String -> (LevelId, Int) -> String
forall v. Show v => String -> v -> String
`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
type ItemFloor = EM.EnumMap Point ItemBag
type BigActorMap = EM.EnumMap Point ActorId
type ProjectileMap = EM.EnumMap Point [ActorId]
type TileMap = PointArray.Array (ContentId TileKind)
type SmellMap = EM.EnumMap Point Time
type EntryMap = EM.EnumMap Point PlaceEntry
data Level = Level
{ Level -> ContentId CaveKind
lkind :: ContentId CaveKind
, Level -> AbsDepth
ldepth :: Dice.AbsDepth
, Level -> ItemFloor
lfloor :: ItemFloor
, Level -> ItemFloor
lembed :: ItemFloor
, Level -> BigActorMap
lbig :: BigActorMap
, Level -> ProjectileMap
lproj :: ProjectileMap
, Level -> TileMap
ltile :: TileMap
, Level -> EntryMap
lentry :: EntryMap
, Level -> Area
larea :: Area
, Level -> SmellMap
lsmell :: SmellMap
, Level -> ([Point], [Point])
lstair :: ([Point], [Point])
, Level -> [Point]
lescape :: [Point]
, Level -> Int
lseen :: Int
, Level -> Int
lexpl :: Int
, Level -> Time
ltime :: Time
, Level -> Bool
lnight :: Bool
}
deriving (Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Level -> ShowS
showsPrec :: Int -> Level -> ShowS
$cshow :: Level -> String
show :: Level -> String
$cshowList :: [Level] -> ShowS
showList :: [Level] -> ShowS
Show, Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
/= :: Level -> Level -> Bool
Eq)
assertSparseItems :: ItemFloor -> ItemFloor
assertSparseItems :: ItemFloor -> ItemFloor
assertSparseItems ItemFloor
m =
Bool -> ItemFloor -> ItemFloor
forall a. (?callStack::CallStack) => 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 -> (String, ItemFloor) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"null floors found" String -> ItemFloor -> (String, ItemFloor)
forall v. String -> v -> (String, 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. (?callStack::CallStack) => 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 -> (String, ProjectileMap) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"null projectile lists found" String -> ProjectileMap -> (String, ProjectileMap)
forall v. String -> v -> (String, v)
`swith` ProjectileMap
m) ProjectileMap
m
updateFloor :: (ItemFloor -> ItemFloor) -> Level -> Level
{-# INLINE updateFloor #-}
updateFloor :: (ItemFloor -> ItemFloor) -> Level -> Level
updateFloor ItemFloor -> ItemFloor
f Level
lvl = Level
lvl {lfloor = f (lfloor lvl)}
updateEmbed :: (ItemFloor -> ItemFloor) -> Level -> Level
updateEmbed :: (ItemFloor -> ItemFloor) -> Level -> Level
updateEmbed ItemFloor -> ItemFloor
f Level
lvl = Level
lvl {lembed = f (lembed lvl)}
updateBigMap :: (BigActorMap -> BigActorMap) -> Level -> Level
updateBigMap :: (BigActorMap -> BigActorMap) -> Level -> Level
updateBigMap BigActorMap -> BigActorMap
f Level
lvl = Level
lvl {lbig = f (lbig lvl)}
updateProjMap :: (ProjectileMap -> ProjectileMap) -> Level -> Level
{-# INLINE updateProjMap #-}
updateProjMap :: (ProjectileMap -> ProjectileMap) -> Level -> Level
updateProjMap ProjectileMap -> ProjectileMap
f Level
lvl = Level
lvl {lproj = f (lproj lvl)}
updateTile :: (TileMap -> TileMap) -> Level -> Level
updateTile :: (TileMap -> TileMap) -> Level -> Level
updateTile TileMap -> TileMap
f Level
lvl = Level
lvl {ltile = f (ltile lvl)}
updateEntry :: (EntryMap -> EntryMap) -> Level -> Level
updateEntry :: (EntryMap -> EntryMap) -> Level -> Level
updateEntry EntryMap -> EntryMap
f Level
lvl = Level
lvl {lentry = f (lentry lvl)}
updateSmell :: (SmellMap -> SmellMap) -> Level -> Level
updateSmell :: (SmellMap -> SmellMap) -> Level -> Level
updateSmell SmellMap -> SmellMap
f Level
lvl = Level
lvl {lsmell = f (lsmell lvl)}
at :: Level -> Point -> ContentId TileKind
{-# INLINE at #-}
at :: Level -> Point -> ContentId TileKind
at Level{TileMap
ltile :: Level -> TileMap
ltile :: 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
findPosTry :: Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> 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. (?callStack::CallStack) => a
undefined
findPosTry2 :: Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> 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 :: Level -> TileMap
ltile :: TileMap
ltile, Area
larea :: Level -> Area
larea :: 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. (?callStack::CallStack) => 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)
let Point{Int
px :: Int
py :: Int
px :: Point -> Int
py :: Point -> 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 a. a -> StateT SMGen Identity a
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 a. a -> StateT SMGen Identity a
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)
(\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
nearbyPassablePoints :: COps -> Level -> Point -> [Point]
nearbyPassablePoints :: COps -> Level -> Point -> [Point]
nearbyPassablePoints cops :: COps
cops@COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax, Int
rHeightMax :: Int
rHeightMax :: RuleContent -> 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)
semiRandomWrap :: [Point] -> [Point]
semiRandomWrap [Point]
l = if [Point] -> Bool
forall a. [a] -> Bool
null [Point]
l then String -> [Point]
forall a. (?callStack::CallStack) => String -> a
error String
"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 a b. (a -> b -> b) -> b -> [a] -> b
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 a b. (a -> b -> b) -> b -> [a] -> b
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
sortEmbeds :: COps -> ContentId TileKind -> [(IK.ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
sortEmbeds :: COps
-> ContentId TileKind
-> [(ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
sortEmbeds COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> 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
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
lstair :: Level -> ([Point], [Point])
lkind :: Level -> ContentId CaveKind
ldepth :: Level -> AbsDepth
lfloor :: Level -> ItemFloor
lembed :: Level -> ItemFloor
lbig :: Level -> BigActorMap
lproj :: Level -> ProjectileMap
ltile :: Level -> TileMap
lentry :: Level -> EntryMap
larea :: Level -> Area
lsmell :: Level -> SmellMap
lescape :: Level -> [Point]
lseen :: Level -> Int
lexpl :: Level -> Int
ltime :: Level -> Time
lnight :: Level -> Bool
lkind :: ContentId CaveKind
ldepth :: AbsDepth
lfloor :: ItemFloor
lembed :: ItemFloor
lbig :: BigActorMap
lproj :: ProjectileMap
ltile :: TileMap
lentry :: EntryMap
larea :: Area
lsmell :: SmellMap
lstair :: ([Point], [Point])
lescape :: [Point]
lseen :: Int
lexpl :: Int
ltime :: Time
lnight :: Bool
..} = 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 a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Level -> Get Level) -> Level -> Get Level
forall a b. (a -> b) -> a -> b
$! Level{Bool
Int
[Point]
([Point], [Point])
ProjectileMap
ItemFloor
SmellMap
BigActorMap
EntryMap
AbsDepth
Time
ContentId CaveKind
Area
TileMap
lstair :: ([Point], [Point])
lkind :: ContentId CaveKind
ldepth :: AbsDepth
lfloor :: ItemFloor
lembed :: ItemFloor
lbig :: BigActorMap
lproj :: ProjectileMap
ltile :: TileMap
lentry :: EntryMap
larea :: Area
lsmell :: SmellMap
lescape :: [Point]
lseen :: Int
lexpl :: Int
ltime :: Time
lnight :: Bool
lkind :: ContentId CaveKind
ldepth :: AbsDepth
lfloor :: ItemFloor
lembed :: ItemFloor
lbig :: BigActorMap
lproj :: ProjectileMap
ltile :: TileMap
lentry :: EntryMap
larea :: Area
lsmell :: SmellMap
lstair :: ([Point], [Point])
lescape :: [Point]
lseen :: Int
lexpl :: Int
ltime :: Time
lnight :: Bool
..}