module Game.LambdaHack.Level
(
Party, PartyItem, SmellMap, SecretMap, ItemMap, TileMap, Level(..)
, updateHeroes, updateMonsters, updateHeroItem, updateMonItem
, updateSmell, updateIMap, updateLMap, updateLRMap, dropItemsAt
, at, rememberAt, atI, rememberAtI
, stdRuleset, accessible, openable, findLoc, findLocTry
) where
import Data.Binary
import qualified Data.List as L
import qualified Data.IntMap as IM
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.PointXY
import Game.LambdaHack.Point
import Game.LambdaHack.Actor
import Game.LambdaHack.Item
import Game.LambdaHack.Content.TileKind
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Random
import Game.LambdaHack.Tile
import qualified Game.LambdaHack.Feature as F
import qualified Game.LambdaHack.Kind as Kind
type Party = IM.IntMap Actor
type PartyItem = IM.IntMap [Item]
type SmellMap = IM.IntMap SmellTime
type SecretMap = IM.IntMap SecretStrength
type ItemMap = IM.IntMap ([Item], [Item])
type TileMap = Kind.Array Point TileKind
data Level = Level
{ lheroes :: Party
, lheroItem :: PartyItem
, lxsize :: X
, lysize :: Y
, lmonsters :: Party
, lmonItem :: PartyItem
, lsmell :: SmellMap
, lsecret :: SecretMap
, litem :: ItemMap
, lmap :: TileMap
, lrmap :: TileMap
, ldesc :: String
, lmeta :: String
, lstairs :: (Point, Point)
}
deriving Show
updateHeroes, updateMonsters :: (Party -> Party) -> Level -> Level
updateHeroes f lvl = lvl { lheroes = f (lheroes lvl) }
updateMonsters f lvl = lvl { lmonsters = f (lmonsters lvl) }
updateHeroItem, updateMonItem :: (PartyItem -> PartyItem) -> Level -> Level
updateHeroItem f lvl = lvl { lheroItem = f (lheroItem lvl) }
updateMonItem f lvl = lvl { lmonItem = f (lmonItem lvl) }
updateSmell :: (SmellMap -> SmellMap) -> Level -> Level
updateSmell f lvl = lvl { lsmell = f (lsmell lvl) }
updateIMap :: (ItemMap -> ItemMap) -> Level -> Level
updateIMap f lvl = lvl { litem = f (litem lvl) }
updateLMap, updateLRMap :: (TileMap -> TileMap) -> Level -> Level
updateLMap f lvl = lvl { lmap = f (lmap lvl) }
updateLRMap f lvl = lvl { lrmap = f (lrmap lvl) }
dropItemsAt :: [Item] -> Point -> Level -> Level
dropItemsAt [] _loc = id
dropItemsAt items loc =
let joinItems = L.foldl' (\ acc i -> snd (joinItem i acc))
adj Nothing = Just (items, [])
adj (Just (i, ri)) = Just (joinItems items i, ri)
in updateIMap (IM.alter adj loc)
instance Binary Level where
put (Level hs hi sx sy ms mi ls le li lm lrm ld lme lstairs) = do
put hs
put hi
put sx
put sy
put ms
put mi
put ls
put le
put (assert
(IM.null (IM.filter (\ (is1, is2) ->
L.null is1 && L.null is2) li)
`blame` li) li)
put lm
put lrm
put ld
put lme
put lstairs
get = do
hs <- get
hi <- get
sx <- get
sy <- get
ms <- get
mi <- get
ls <- get
le <- get
li <- get
lm <- get
lrm <- get
ld <- get
lme <- get
lstairs <- get
return (Level hs hi sx sy ms mi ls le li lm lrm ld lme lstairs)
at, rememberAt :: Level -> Point -> Kind.Id TileKind
at Level{lmap} p = lmap Kind.! p
rememberAt Level{lrmap} p = lrmap Kind.! p
atI, rememberAtI :: Level -> Point -> [Item]
atI Level{litem} p = fst $ IM.findWithDefault ([], []) p litem
rememberAtI Level{litem} p = snd $ IM.findWithDefault ([], []) p litem
stdRuleset :: Kind.Ops RuleKind -> RuleKind
stdRuleset Kind.Ops{ouniqGroup, okind} = okind $ ouniqGroup "standard"
accessible :: Kind.COps -> Level -> Point -> Point -> Bool
accessible Kind.COps{ cotile=Kind.Ops{okind=okind}, corule}
lvl@Level{lxsize} sloc tloc =
let check = raccessible $ stdRuleset corule
src = okind $ lvl `at` sloc
tgt = okind $ lvl `at` tloc
in check lxsize sloc src tloc tgt
openable :: Kind.Ops TileKind -> Level -> SecretStrength -> Point -> Bool
openable cops lvl@Level{lsecret} k target =
let tgt = lvl `at` target
in hasFeature cops F.Openable tgt ||
(hasFeature cops F.Hidden tgt &&
lsecret IM.! target < k)
findLoc :: TileMap -> (Point -> Kind.Id TileKind -> Bool) -> Rnd Point
findLoc lmap p =
let search = do
loc <- randomR $ Kind.bounds lmap
let tile = lmap Kind.! loc
if p loc tile
then return loc
else search
in search
findLocTry :: Int
-> TileMap
-> [Point -> Kind.Id TileKind -> Bool]
-> Rnd Point
findLocTry _ lmap [p] = findLoc lmap p
findLocTry numTries lmap l = assert (numTries > 0) $
let search 0 = findLocTry numTries lmap (L.tail l)
search k = do
loc <- randomR $ Kind.bounds lmap
let tile = lmap Kind.! loc
if L.all (\ p -> p loc tile) l
then return loc
else search (k 1)
in search numTries