module Game.LambdaHack.Server.Fov
( dungeonPerception, fidLidPerception
, PersLit, litInDungeon
#ifdef EXPOSE_INTERNAL
, PerceptionLit, ActorEqpBody
#endif
) where
import Control.Exception.Assert.Sugar
import qualified Data.EnumMap.Lazy as EML
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import Data.List
import Data.Ord
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import qualified Game.LambdaHack.Common.Effect as Effect
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemStrongest
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
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 PerceptionLit = PerceptionLit
{plit :: ES.EnumSet Point}
deriving Show
type ActorEqpBody = [((ActorId, Actor), [ItemFull])]
type PersLit = EML.EnumMap LevelId ( PerceptionLit
, EM.EnumMap FactionId ActorEqpBody )
levelPerception :: Kind.COps -> PerceptionLit -> ActorEqpBody
-> FovMode -> Level
-> Perception
levelPerception cops litHere actorEqpBody fovMode lvl@Level{lxsize, lysize} =
let
ours = filter (not . bproj . snd . fst) actorEqpBody
ourR = preachable . reachableFromActor cops fovMode lvl
totalReachable = PerceptionReachable $ concatMap ourR ours
pAndVicinity p = p : vicinity lxsize lysize p
noctoBodies = map (\aEB@((_, b), _) -> (pAndVicinity (bpos b), aEB)) ours
nocto = concat $ map fst noctoBodies
ptotal = visibleOnLevel cops totalReachable litHere nocto lvl
canSmellAround (_, allAssocs) =
let radius = sumSlotNoFilter Effect.EqpSlotAddSmell allAssocs
in radius >= 2
psmell = PerceptionVisible $ ES.fromList
$ concat $ map fst $ filter (canSmellAround . snd) noctoBodies
in Perception ptotal psmell
fidLidPerception :: Kind.COps -> FovMode -> PersLit
-> FactionId -> LevelId -> Level
-> Perception
fidLidPerception cops fovMode persLit fid lid lvl =
let (litHere, bodyMap) = persLit EML.! lid
actorEqpBody = EM.findWithDefault [] fid bodyMap
in levelPerception cops litHere actorEqpBody fovMode lvl
factionPerception :: FovMode -> PersLit -> FactionId -> State -> FactionPers
factionPerception fovMode persLit fid s =
EM.mapWithKey (fidLidPerception (scops s) 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 :: Kind.COps -> PerceptionReachable
-> PerceptionLit -> [Point] -> Level
-> PerceptionVisible
visibleOnLevel Kind.COps{cotile}
PerceptionReachable{preachable} PerceptionLit{plit}
nocto lvl =
let isVisible pos = Tile.isLit cotile (lvl `at` pos) || pos `ES.member` plit
in PerceptionVisible $ ES.fromList $ nocto ++ filter isVisible preachable
reachableFromActor :: Kind.COps -> FovMode -> Level
-> ((ActorId, Actor), [ItemFull])
-> PerceptionReachable
reachableFromActor cops fovMode lvl ((_, body), allItems) =
let sumSight = sumSlotNoFilter Effect.EqpSlotAddSight allItems
radius = min (fromIntegral $ bcalm body `div` (5 * oneM)) sumSight
in PerceptionReachable $ fullscan cops fovMode radius (bpos body) lvl
litByItems :: Kind.COps -> FovMode -> Level
-> [(Point, [ItemFull])]
-> PerceptionLit
litByItems cops@Kind.COps{cotile} fovMode lvl allItems =
let litPos :: (Point, [ItemFull]) -> [Point]
litPos (p, is) =
let radius = sumSlotNoFilter Effect.EqpSlotAddLight is
scan = fullscan cops fovMode radius p lvl
opt = filter (\pos -> not $ Tile.isLit cotile $ lvl `at` pos) scan
in opt
litAll = concatMap litPos allItems
in PerceptionLit $ ES.fromList litAll
litInDungeon :: FovMode -> State -> StateServer -> PersLit
litInDungeon fovMode s ser =
let cops = scops s
itemsInActors :: Level -> EM.EnumMap FactionId ActorEqpBody
itemsInActors lvl =
let asLid = map (\aid -> (aid, getActorBody aid s))
$ concat $ EM.elems $ lprio lvl
asGrouped = groupBy ((==) `on` (bfid . snd))
$ sortBy (comparing (bfid . snd)) asLid
bodyFid :: [(ActorId, Actor)] -> (FactionId, ActorEqpBody)
bodyFid [] = assert `failure` asGrouped
bodyFid asFid@((_, bFid) : _) =
let fid = bfid bFid
eqpBody (aid, b) =
( (aid, b)
, map snd $ fullAssocs cops (sdiscoKind ser) (sdiscoEffect ser)
aid [COrgan, CEqp] s )
in (fid, map eqpBody asFid)
in EM.fromDistinctAscList $ map bodyFid asGrouped
itemsOnFloor :: Level -> [(Point, [ItemFull])]
itemsOnFloor lvl =
let iToFull (iid, (item, k)) =
itemToFull cops (sdiscoKind ser) (sdiscoEffect ser) iid item k
processPos (p, bag) =
(p, map iToFull $ bagAssocsK s bag)
in map processPos $ EM.assocs $ lfloor lvl
litOnLevel :: Level -> ( PerceptionLit
, EM.EnumMap FactionId ActorEqpBody )
litOnLevel lvl =
let bodyMap = itemsInActors lvl
allBodies = concat $ EM.elems bodyMap
actorItems = map (\((_, b), iis) -> (bpos b, iis)) allBodies
floorItems = itemsOnFloor lvl
allItems = floorItems ++ actorItems
in (litByItems cops fovMode lvl allItems, bodyMap)
litLvl (lid, lvl) = (lid, litOnLevel lvl)
in EML.fromDistinctAscList $ map litLvl $ EM.assocs $ sdungeon s
fullscan :: Kind.COps
-> FovMode
-> Int
-> Point
-> Level
-> [Point]
fullscan Kind.COps{cotile} fovMode radius spectatorPos lvl =
if radius <= 0 then []
else if radius == 1 then [spectatorPos]
else 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 = Tile.isClear cotile . (lvl `at`)
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)
]