module Game.LambdaHack.Server.Fov
( dungeonPerception, levelPerception
, fullscan, FovMode(..)
) where
import Control.Arrow (second)
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.List as L
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 Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Common.VectorXY
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.Content.TileKind
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
newtype PerceptionReachable = PerceptionReachable
{ preachable :: ES.EnumSet Point }
deriving Show
levelPerception :: Kind.COps -> State -> FovMode -> FactionId
-> LevelId -> Level
-> Perception
levelPerception cops@Kind.COps{cotile} s configFov fid lid lvl =
let hs = actorAssocs (== fid) lid s
reas = map (second $ computeReachable cops configFov lvl) hs
lreas = map (preachable . snd) reas
totalRea = PerceptionReachable $ ES.unions lreas
lights = ES.fromList $ map (bpos . snd) hs
ptotal = computeVisible cotile totalRea lvl lights
g = PerceptionVisible . ES.intersection (pvisible ptotal) . preachable
perActor = EM.map g $ EM.fromList reas
psmell = smellFromActors cops s perActor
in Perception {..}
factionPerception :: Kind.COps -> FovMode -> State -> FactionId
-> FactionPers
factionPerception cops configFov s fid =
EM.mapWithKey (levelPerception cops s configFov fid) $ sdungeon s
dungeonPerception :: Kind.COps -> FovMode -> State -> Pers
dungeonPerception cops configFov s =
let f fid _ = factionPerception cops configFov s fid
in EM.mapWithKey f $ sfactionD s
computeVisible :: Kind.Ops TileKind -> PerceptionReachable
-> Level -> ES.EnumSet Point -> PerceptionVisible
computeVisible cotile reachable@PerceptionReachable{preachable} lvl lights =
let isV = isVisible cotile reachable lvl lights
in PerceptionVisible $ ES.filter isV preachable
isVisible :: Kind.Ops TileKind -> PerceptionReachable
-> Level -> ES.EnumSet Point -> Point -> Bool
isVisible cotile PerceptionReachable{preachable}
lvl@Level{lxsize, lysize} lights pos0 =
let litDirectly pos = Tile.isLit cotile (lvl `at` pos)
|| pos `ES.member` lights
l_and_R pos = litDirectly pos && pos `ES.member` preachable
in litDirectly pos0 || L.any l_and_R (vicinity lxsize lysize pos0)
computeReachable :: Kind.COps -> FovMode -> Level -> Actor
-> PerceptionReachable
computeReachable Kind.COps{cotile, coactor=Kind.Ops{okind}}
configFov lvl body =
let sight = asight $ okind $ bkind body
fovMode = if sight then configFov else Blind
ppos = bpos body
scan = fullscan cotile fovMode ppos lvl
in PerceptionReachable $ ES.fromList scan
fullscan :: Kind.Ops TileKind
-> FovMode
-> Point
-> Level
-> [Point]
fullscan cotile fovMode spectatorPos Level{lxsize, ltile} = spectatorPos :
case fovMode of
Shadow ->
L.concatMap (\ tr -> map tr (Shadow.scan (isCl . tr) 1 (0, 1))) tr8
Permissive ->
L.concatMap (\ tr -> map tr (Permissive.scan (isCl . tr))) tr4
Digital r ->
L.concatMap (\ tr -> map tr (Digital.scan r (isCl . tr))) tr4
Blind ->
let radiusOne = 1
in L.concatMap (\ tr -> map tr (Digital.scan radiusOne (isCl . tr))) tr4
where
isCl :: Point -> Bool
isCl = Tile.isClear cotile . (ltile Kind.!)
trV xy = shift spectatorPos $ toVector lxsize $ VectorXY xy
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(x, y)) -> trV ( x, y)
, \ (B(x, y)) -> trV ( y, x)
, \ (B(x, y)) -> trV ( x, y)
, \ (B(x, y)) -> trV ( y, x)
]
data FovMode =
Shadow
| Permissive
| Digital !Int
| Blind
deriving (Show, Read)
instance Binary FovMode where
put Shadow = putWord8 0
put Permissive = putWord8 1
put (Digital r) = putWord8 2 >> put r
put Blind = putWord8 3
get = do
tag <- getWord8
case tag of
0 -> return Shadow
1 -> return Permissive
2 -> fmap Digital get
3 -> return Blind
_ -> fail "no parse (FovMode)"