module Game.LambdaHack.Perception
( Perception, totalVisible, debugTotalReachable, perception
, actorReachesLoc, actorReachesActor, monsterSeesHero
) where
import qualified Data.IntSet as IS
import qualified Data.List as L
import qualified Data.IntMap as IM
import Data.Maybe
import Control.Monad
import Game.LambdaHack.Point
import Game.LambdaHack.State
import Game.LambdaHack.Level
import Game.LambdaHack.Actor
import Game.LambdaHack.ActorState
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.FOV
import qualified Game.LambdaHack.Config as Config
import qualified Game.LambdaHack.Tile as Tile
import qualified Game.LambdaHack.Kind as Kind
import Game.LambdaHack.Content.TileKind
newtype PerceptionReachable = PerceptionReachable
{ preachable :: IS.IntSet
}
newtype PerceptionVisible = PerceptionVisible
{ pvisible :: IS.IntSet
}
data Perception = Perception
{ pplayer :: Maybe PerceptionReachable
, pheroes :: IM.IntMap PerceptionReachable
, ptotal :: PerceptionVisible
}
totalVisible :: Perception -> IS.IntSet
totalVisible = pvisible . ptotal
debugTotalReachable :: Perception -> IS.IntSet
debugTotalReachable per =
let lpers = maybeToList (pplayer per) ++ IM.elems (pheroes per)
in IS.unions (map preachable lpers)
actorReachesLoc :: ActorId -> Point -> Perception -> Maybe ActorId -> Bool
actorReachesLoc actor loc per pl =
let tryHero = case actor of
AMonster _ -> Nothing
AHero i -> do
hper <- IM.lookup i (pheroes per)
return $ loc `IS.member` preachable hper
tryPl = do
guard $ Just actor == pl
pper <- pplayer per
return $ loc `IS.member` preachable pper
tryAny = tryHero `mplus` tryPl
in fromMaybe False tryAny
actorReachesActor :: ActorId -> ActorId -> Point -> Point
-> Perception -> Maybe ActorId
-> Bool
actorReachesActor actor1 actor2 loc1 loc2 per pl =
actorReachesLoc actor1 loc2 per pl ||
actorReachesLoc actor2 loc1 per pl
monsterSeesHero :: Kind.Ops TileKind -> Perception -> Level
-> ActorId -> ActorId -> Point -> Point -> Bool
monsterSeesHero cotile per lvl _source target sloc tloc =
let rempty = PerceptionReachable IS.empty
reachable@PerceptionReachable{preachable} = case target of
AMonster _ -> rempty
AHero i -> fromMaybe rempty $ IM.lookup i $ pheroes per
in sloc `IS.member` preachable
&& isVisible cotile reachable lvl IS.empty tloc
perception :: Kind.COps -> State -> Perception
perception cops@Kind.COps{cotile}
state@State{ splayer
, sconfig
, sdebug = DebugMode{smarkVision}
} =
let lvl@Level{lheroes = hs} = slevel state
mode = Config.get sconfig "engine" "fovMode"
radius = let r = Config.get sconfig "engine" "fovRadius"
in if r < 1
then error $ "FOV radius is " ++ show r ++ ", should be >= 1"
else r
mLocPer =
if isAMonster splayer && memActor splayer state
then let m = getPlayerBody state
in Just (bloc m,
computeReachable cops radius mode smarkVision m lvl)
else Nothing
(mLoc, mPer) = (fmap fst mLocPer, fmap snd mLocPer)
pers = IM.map (\ h ->
computeReachable cops radius mode smarkVision h lvl) hs
locs = IM.map bloc hs
lpers = maybeToList mPer ++ IM.elems pers
reachable = PerceptionReachable $ IS.unions (map preachable lpers)
playerControlledMonsterLight = maybeToList mLoc
lights = IS.fromList $ playerControlledMonsterLight ++ IM.elems locs
visible = computeVisible cotile reachable lvl lights
in Perception { pplayer = mPer
, pheroes = pers
, ptotal = visible
}
computeVisible :: Kind.Ops TileKind -> PerceptionReachable
-> Level -> IS.IntSet -> PerceptionVisible
computeVisible cops reachable@PerceptionReachable{preachable} lvl lights' =
let lights = IS.intersection lights' preachable
isV = isVisible cops reachable lvl lights
in PerceptionVisible $ IS.filter isV preachable
isVisible :: Kind.Ops TileKind -> PerceptionReachable
-> Level -> IS.IntSet -> Point -> Bool
isVisible cotile PerceptionReachable{preachable}
lvl@Level{lxsize, lysize} lights loc0 =
let litDirectly loc = Tile.isLit cotile (lvl `at` loc)
|| loc `IS.member` lights
l_and_R loc = litDirectly loc && loc `IS.member` preachable
in litDirectly loc0 || L.any l_and_R (vicinity lxsize lysize loc0)
computeReachable :: Kind.COps -> Int -> String -> Maybe FovMode
-> Actor -> Level -> PerceptionReachable
computeReachable Kind.COps{cotile, coactor=Kind.Ops{okind}}
radius mode smarkVision actor lvl =
let fovMode m =
if not $ asight $ okind $ bkind m
then Blind
else case smarkVision of
Just fm -> fm
Nothing -> case mode of
"shadow" -> Shadow
"permissive" -> Permissive
"digital" -> Digital radius
_ -> error $ "Unknown FOV mode: " ++ show mode
ploc = bloc actor
in PerceptionReachable $
IS.insert ploc $ IS.fromList $ fullscan cotile (fovMode actor) ploc lvl