module Game.LambdaHack.Server.Fov
(
FovValid(..), PerValidFid
, PerReachable(..), CacheBeforeLucid(..), PerActor
, PerceptionCache(..), PerCacheLid, PerCacheFid
, FovShine(..), FovLucid(..), FovLucidLid
, FovClear(..), FovClearLid, FovLit (..), FovLitLid
, perceptionFromPTotal, perActorFromLevel, boundSightByCalm
, totalFromPerActor, lucidFromLevel, perFidInDungeon
#ifdef EXPOSE_INTERNAL
, cacheBeforeLucidFromActor, shineFromLevel, floorLightSources, lucidFromItems
, litFromLevel, litInDungeon, clearFromLevel, clearInDungeon, lucidInDungeon
, perLidFromFaction, perceptionCacheFromLevel
, Matrix, fullscan
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Int (Int64)
import qualified Data.IntSet as IS
import GHC.Exts (inline)
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Server.FovDigital
data FovValid a =
FovValid a
| FovInvalid
deriving (Show, Eq)
type PerValidFid = EM.EnumMap FactionId (EM.EnumMap LevelId Bool)
newtype PerReachable = PerReachable {preachable :: ES.EnumSet Point}
deriving (Show, Eq)
data CacheBeforeLucid = CacheBeforeLucid
{ creachable :: PerReachable
, cnocto :: PerVisible
, csmell :: PerSmelled
}
deriving (Show, Eq)
type PerActor = EM.EnumMap ActorId (FovValid CacheBeforeLucid)
data PerceptionCache = PerceptionCache
{ ptotal :: FovValid CacheBeforeLucid
, perActor :: PerActor
}
deriving (Show, Eq)
type PerCacheLid = EM.EnumMap LevelId PerceptionCache
type PerCacheFid = EM.EnumMap FactionId PerCacheLid
newtype FovShine = FovShine {fovShine :: EM.EnumMap Point Int}
deriving (Show, Eq)
newtype FovLucid = FovLucid {fovLucid :: ES.EnumSet Point}
deriving (Show, Eq)
type FovLucidLid = EM.EnumMap LevelId (FovValid FovLucid)
newtype FovClear = FovClear {fovClear :: PointArray.Array Bool}
deriving (Show, Eq)
type FovClearLid = EM.EnumMap LevelId FovClear
newtype FovLit = FovLit {fovLit :: ES.EnumSet Point}
deriving (Show, Eq)
type FovLitLid = EM.EnumMap LevelId FovLit
perceptionFromPTotal :: FovLucid -> CacheBeforeLucid -> Perception
perceptionFromPTotal FovLucid{fovLucid} ptotal =
let nocto = pvisible $ cnocto ptotal
reach = preachable $ creachable ptotal
psight = PerVisible $ nocto `ES.union` (reach `ES.intersection` fovLucid)
psmell = csmell ptotal
in Perception{..}
perActorFromLevel :: PerActor -> (ActorId -> Actor)
-> ActorMaxSkills -> FovClear
-> PerActor
perActorFromLevel perActorOld getActorB actorMaxSkills fovClear =
let f _ fv@FovValid{} = fv
f aid FovInvalid =
let actorMaxSk = actorMaxSkills EM.! aid
b = getActorB aid
in FovValid $ cacheBeforeLucidFromActor fovClear b actorMaxSk
in EM.mapWithKey f perActorOld
boundSightByCalm :: Int -> Int64 -> Int
boundSightByCalm sight calm = min (fromEnum $ calm `div` xM 5) sight
cacheBeforeLucidFromActor :: FovClear -> Actor -> Ability.Skills
-> CacheBeforeLucid
cacheBeforeLucidFromActor clearPs body actorMaxSk =
let radius =
boundSightByCalm (Ability.getSk Ability.SkSight actorMaxSk) (bcalm body)
spectatorPos = bpos body
creachable = PerReachable $ fullscan radius spectatorPos clearPs
cnocto = PerVisible $ fullscan (Ability.getSk Ability.SkNocto actorMaxSk)
spectatorPos
clearPs
smellRadius =
if Ability.getSk Ability.SkSmell actorMaxSk >= 2 then 2 else 0
csmell = PerSmelled $ fullscan smellRadius spectatorPos clearPs
in CacheBeforeLucid{..}
totalFromPerActor :: PerActor -> CacheBeforeLucid
totalFromPerActor perActor =
let as = map (\case
FovValid x -> x
FovInvalid -> error $ "" `showFailure` perActor)
$ EM.elems perActor
in CacheBeforeLucid
{ creachable = PerReachable
$ ES.unions $ map (preachable . creachable) as
, cnocto = PerVisible
$ ES.unions $ map (pvisible . cnocto) as
, csmell = PerSmelled
$ ES.unions $ map (psmelled . csmell) as }
lucidFromLevel :: FovClearLid -> FovLitLid -> State -> LevelId -> Level
-> FovLucid
lucidFromLevel fovClearLid fovLitLid s lid lvl =
let shine = shineFromLevel s lid lvl
lucids = lucidFromItems (fovClearLid EM.! lid)
$ EM.assocs $ fovShine shine
litTiles = fovLitLid EM.! lid
in FovLucid $ ES.unions $ fovLit litTiles : map fovLucid lucids
shineFromLevel :: State -> LevelId -> Level -> FovShine
shineFromLevel s lid lvl =
let actorLights =
[ (bpos b, radius)
| (aid, b) <- inline actorAssocs (const True) lid s
, let radius = Ability.getSk Ability.SkShine $ getActorMaxSkills aid s
, radius > 0 ]
floorLights = floorLightSources (sdiscoAspect s) lvl
allLights = floorLights ++ actorLights
in FovShine $ EM.fromListWith max allLights
floorLightSources :: DiscoveryAspect -> Level -> [(Point, Int)]
floorLightSources discoAspect lvl =
let processIid (accLight, accDouse) (iid, _) =
let shine = IA.getSkill Ability.SkShine $ discoAspect EM.! iid
in case compare shine 0 of
EQ -> (accLight, accDouse)
GT -> (max shine accLight, accDouse)
LT -> (accLight, min shine accDouse)
processBag bag acc = foldl' processIid acc $ EM.assocs bag
in [ (p, radius)
| (p, bag) <- EM.assocs $ lfloor lvl
, let (maxLight, maxDouse) = processBag bag (0, 0)
radius = maxLight + maxDouse
, radius > 0 ]
lucidFromItems :: FovClear -> [(Point, Int)] -> [FovLucid]
lucidFromItems clearPs allItems =
let lucidPos (!p, !shine) = FovLucid $ fullscan shine p clearPs
in map lucidPos allItems
perFidInDungeon :: State -> ( FovLitLid, FovClearLid, FovLucidLid
, PerValidFid, PerCacheFid, PerFid)
perFidInDungeon s =
let fovLitLid = litInDungeon s
fovClearLid = clearInDungeon s
fovLucidLid = lucidInDungeon fovClearLid fovLitLid s
perValidLid = EM.map (const True) (sdungeon s)
perValidFid = EM.map (const perValidLid) (sfactionD s)
f fid _ = perLidFromFaction fovLucidLid fovClearLid fid s
em = EM.mapWithKey f $ sfactionD s
in ( fovLitLid, fovClearLid, fovLucidLid
, perValidFid, EM.map snd em, EM.map fst em)
litFromLevel :: COps -> Level -> FovLit
litFromLevel COps{coTileSpeedup} Level{ltile} =
let litSet p t set = if Tile.isLit coTileSpeedup t then p : set else set
in FovLit $ ES.fromDistinctAscList $ PointArray.ifoldrA' litSet [] ltile
litInDungeon :: State -> FovLitLid
litInDungeon s = EM.map (litFromLevel (scops s)) $ sdungeon s
clearFromLevel :: COps -> Level -> FovClear
clearFromLevel COps{coTileSpeedup} Level{ltile} =
FovClear $ PointArray.mapA (Tile.isClear coTileSpeedup) ltile
clearInDungeon :: State -> FovClearLid
clearInDungeon s = EM.map (clearFromLevel (scops s)) $ sdungeon s
lucidInDungeon :: FovClearLid -> FovLitLid -> State -> FovLucidLid
lucidInDungeon fovClearLid fovLitLid s =
EM.mapWithKey
(\lid lvl -> FovValid $ lucidFromLevel fovClearLid fovLitLid s lid lvl)
$ sdungeon s
perLidFromFaction :: FovLucidLid -> FovClearLid -> FactionId -> State
-> (PerLid, PerCacheLid)
perLidFromFaction fovLucidLid fovClearLid fid s =
let em = EM.mapWithKey (\lid _ ->
perceptionCacheFromLevel fovClearLid fid lid s)
(sdungeon s)
fovLucid lid = case EM.lookup lid fovLucidLid of
Just (FovValid fl) -> fl
_ -> error $ "" `showFailure` (lid, fovLucidLid)
getValid (FovValid pc) = pc
getValid FovInvalid = error $ "" `showFailure` fid
in ( EM.mapWithKey (\lid pc ->
perceptionFromPTotal (fovLucid lid) (getValid (ptotal pc))) em
, em )
perceptionCacheFromLevel :: FovClearLid -> FactionId -> LevelId -> State
-> PerceptionCache
perceptionCacheFromLevel fovClearLid fid lid s =
let fovClear = fovClearLid EM.! lid
lvlBodies = inline actorAssocs (== fid) lid s
f (aid, b) =
let actorMaxSk = getActorMaxSkills aid s
in if Ability.getSk Ability.SkSight actorMaxSk <= 0
&& Ability.getSk Ability.SkNocto actorMaxSk <= 0
&& Ability.getSk Ability.SkSmell actorMaxSk <= 0
then Nothing
else Just (aid, FovValid
$ cacheBeforeLucidFromActor fovClear b actorMaxSk)
lvlCaches = mapMaybe f lvlBodies
perActor = EM.fromDistinctAscList lvlCaches
total = totalFromPerActor perActor
in PerceptionCache{ptotal = FovValid total, perActor}
type Matrix = (Int, Int, Int, Int)
fullscan :: Int
-> Point
-> FovClear
-> ES.EnumSet Point
fullscan !radius spectatorPos fc = case radius of
2 -> squareUnsafeSet spectatorPos
1 -> ES.singleton spectatorPos
0 -> ES.empty
_ | radius <= 0 -> ES.empty
_ ->
let !FovClear{fovClear} = fc
!spectatorI = fromEnum spectatorPos
mapTr :: Matrix -> [PointI]
mapTr m@(!_, !_, !_, !_) = scan (radius - 1) isClear (trV m)
trV :: Matrix -> Bump -> PointI
{-# INLINE trV #-}
trV (x1, y1, x2, y2) B{..} =
spectatorI + fromEnum (Vector (x1 * bx + y1 * by) (x2 * bx + y2 * by))
isClear :: PointI -> Bool
{-# INLINE isClear #-}
isClear = PointArray.accessI fovClear
in ES.intSetToEnumSet $ IS.fromList
$ [spectatorI]
++ mapTr (1, 0, 0, -1)
++ mapTr (0, 1, 1, 0)
++ mapTr (-1, 0, 0, 1)
++ mapTr (0, -1, -1, 0)