module Game.LambdaHack.Server.Fov
( dungeonPerception, fidLidPerception
, PersLit, litInDungeon
#ifdef EXPOSE_INTERNAL
, PerceptionReachable(..), PerceptionDynamicLit(..)
#endif
) where
import qualified Data.EnumMap.Lazy as EML
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.List
import Data.Maybe
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
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.Vector
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Server.Fov.Common
import qualified Game.LambdaHack.Server.Fov.Digital as Digital
import qualified Game.LambdaHack.Server.Fov.Permissive as Permissive
import qualified Game.LambdaHack.Server.Fov.Shadow as Shadow
import Game.LambdaHack.Server.State
newtype PerceptionReachable = PerceptionReachable
{preachable :: [Point]}
deriving Show
newtype PerceptionDynamicLit = PerceptionDynamicLit
{pdynamicLit :: [Point]}
deriving Show
type PersLit = EML.EnumMap LevelId ( EM.EnumMap FactionId [(Actor, FovCache3)]
, PointArray.Array Bool
, PointArray.Array Bool )
levelPerception :: [(Actor, FovCache3)]
-> PointArray.Array Bool -> PointArray.Array Bool
-> FovMode -> Level
-> Perception
levelPerception actorEqpBody clearPs litPs fovMode Level{lxsize, lysize} =
let
ourR = preachable . reachableFromActor clearPs fovMode
totalReachable = PerceptionReachable $ concatMap ourR actorEqpBody
pAndVicinity p = p : vicinity lxsize lysize p
gatherVicinities = concatMap (pAndVicinity . bpos . fst)
nocteurs = filter (not . bproj . fst) actorEqpBody
nocto = gatherVicinities nocteurs
ptotal = visibleOnLevel totalReachable litPs nocto
canSmellAround FovCache3{fovSmell} = fovSmell >= 2
smellers = filter (canSmellAround . snd) actorEqpBody
smells = gatherVicinities smellers
canHoldSmell p = clearPs PointArray.! p
psmell = PerceptionVisible $ ES.fromList $ filter canHoldSmell smells
in Perception ptotal psmell
fidLidPerception :: FovMode -> PersLit
-> FactionId -> LevelId -> Level
-> Perception
fidLidPerception fovMode persLit fid lid lvl =
let (bodyMap, clearPs, litPs) = persLit EML.! lid
actorEqpBody = EM.findWithDefault [] fid bodyMap
in levelPerception actorEqpBody clearPs litPs fovMode lvl
factionPerception :: FovMode -> PersLit -> FactionId -> State -> FactionPers
factionPerception fovMode persLit fid s =
EM.mapWithKey (fidLidPerception fovMode persLit fid) $ sdungeon s
dungeonPerception :: FovMode -> State -> StateServer -> Pers
dungeonPerception fovMode s ser =
let persLit = litInDungeon fovMode s ser
f fid _ = factionPerception fovMode persLit fid s
in EM.mapWithKey f $ sfactionD s
visibleOnLevel :: PerceptionReachable
-> PointArray.Array Bool -> [Point]
-> PerceptionVisible
visibleOnLevel PerceptionReachable{preachable} litPs nocto =
let isVisible = (litPs PointArray.!)
in PerceptionVisible $ ES.fromList $ nocto ++ filter isVisible preachable
reachableFromActor :: PointArray.Array Bool -> FovMode -> (Actor, FovCache3)
-> PerceptionReachable
reachableFromActor clearPs fovMode (body, FovCache3{fovSight}) =
let radius = min (fromIntegral $ bcalm body `div` (5 * oneM)) fovSight
in PerceptionReachable $ fullscan clearPs fovMode radius (bpos body)
litByItems :: PointArray.Array Bool -> FovMode -> [(Point, Int)]
-> PerceptionDynamicLit
litByItems clearPs fovMode allItems =
let litPos :: (Point, Int) -> [Point]
litPos (p, light) = fullscan clearPs fovMode light p
in PerceptionDynamicLit $ concatMap litPos allItems
litInDungeon :: FovMode -> State -> StateServer -> PersLit
litInDungeon fovMode s ser =
let Kind.COps{cotile} = scops s
processIid3 (FovCache3 sightAcc smellAcc lightAcc) (iid, (k, _)) =
let FovCache3{..} =
EM.findWithDefault emptyFovCache3 iid $ sItemFovCache ser
in FovCache3 (k * fovSight + sightAcc)
(k * fovSmell + smellAcc)
(k * fovLight + lightAcc)
processBag3 bag acc = foldl' processIid3 acc $ EM.assocs bag
itemsInActors :: Level -> EM.EnumMap FactionId [(Actor, FovCache3)]
itemsInActors lvl =
let processActor aid =
let b = getActorBody aid s
sslOrgan = processBag3 (borgan b) emptyFovCache3
ssl = processBag3 (beqp b) sslOrgan
in (bfid b, [(b, ssl)])
asLid = map processActor $ concat $ EM.elems $ lprio lvl
in EM.fromListWith (++) asLid
processIid lightAcc (iid, (k, _)) =
let FovCache3{fovLight} =
EM.findWithDefault emptyFovCache3 iid $ sItemFovCache ser
in k * fovLight + lightAcc
processBag bag acc = foldl' processIid acc $ EM.assocs bag
lightOnFloor :: Level -> [(Point, Int)]
lightOnFloor lvl =
let processPos (p, bag) = (p, processBag bag 0)
in map processPos $ EM.assocs $ lfloor lvl
litOnLevel :: Level -> ( EM.EnumMap FactionId [(Actor, FovCache3)]
, PointArray.Array Bool
, PointArray.Array Bool )
litOnLevel lvl@Level{ltile} =
let bodyMap = itemsInActors lvl
allBodies = concat $ EM.elems bodyMap
clearTiles = PointArray.mapA (Tile.isClear cotile) ltile
blockFromBody (b, _) =
if bproj b then Nothing else Just (bpos b, False)
blockingActors = mapMaybe blockFromBody allBodies
clearPs = clearTiles PointArray.// blockingActors
litTiles = PointArray.mapA (Tile.isLit cotile) ltile
actorLights = map (\(b, FovCache3{fovLight}) -> (bpos b, fovLight))
allBodies
floorLights = lightOnFloor lvl
allLights = floorLights ++ actorLights
litDynamic = pdynamicLit $ litByItems clearPs fovMode allLights
litPs = litTiles PointArray.// map (\p -> (p, True)) litDynamic
in (bodyMap, clearPs, litPs)
litLvl (lid, lvl) = (lid, litOnLevel lvl)
in EML.fromDistinctAscList $ map litLvl $ EM.assocs $ sdungeon s
fullscan :: PointArray.Array Bool
-> FovMode
-> Int
-> Point
-> [Point]
fullscan clearPs fovMode radius spectatorPos
| radius <= 0 = []
| radius == 1 = [spectatorPos]
| otherwise =
spectatorPos : case fovMode of
Shadow ->
concatMap (\tr -> map tr (Shadow.scan (isCl . tr) 1 (0, 1))) tr8
Permissive ->
concatMap (\tr -> map tr (Permissive.scan (isCl . tr))) tr4
Digital ->
concatMap (\tr -> map tr (Digital.scan (radius 1) (isCl . tr))) tr4
where
isCl :: Point -> Bool
isCl = (clearPs PointArray.!)
trV :: X -> Y -> Point
trV x y = shift spectatorPos $ Vector x y
tr8 :: [(Distance, Progress) -> Point]
tr8 =
[ \(p, d) -> trV p d
, \(p, d) -> trV (p) d
, \(p, d) -> trV p (d)
, \(p, d) -> trV (p) (d)
, \(p, d) -> trV d p
, \(p, d) -> trV (d) p
, \(p, d) -> trV d (p)
, \(p, d) -> trV (d) (p)
]
tr4 :: [Bump -> Point]
tr4 =
[ \B{..} -> trV bx (by)
, \B{..} -> trV by bx
, \B{..} -> trV (bx) by
, \B{..} -> trV (by) (bx)
]