-- | Field Of View scanning.
--
-- See <https://github.com/LambdaHack/LambdaHack/wiki/Fov-and-los>
-- for discussion.
module Game.LambdaHack.Server.Fov
  ( -- * Perception cache
    FovValid(..), PerValidFid
  , PerReachable(..), CacheBeforeLucid(..), PerActor
  , PerceptionCache(..), PerCacheLid, PerCacheFid
    -- * Data used in FOV computation and cached to speed it up
  , FovShine(..), FovLucid(..), FovLucidLid
  , FovClear(..), FovClearLid, FovLit (..), FovLitLid
    -- * Operations
  , perceptionFromPTotal, perActorFromLevel, boundSightByCalm
  , totalFromPerActor, lucidFromLevel, perFidInDungeon
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , perceptionFromPTotalNoStash, 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.Faction
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

-- * Perception cache types

data FovValid a =
    FovValid a
  | FovInvalid
  deriving (Int -> FovValid a -> ShowS
[FovValid a] -> ShowS
FovValid a -> String
(Int -> FovValid a -> ShowS)
-> (FovValid a -> String)
-> ([FovValid a] -> ShowS)
-> Show (FovValid a)
forall a. Show a => Int -> FovValid a -> ShowS
forall a. Show a => [FovValid a] -> ShowS
forall a. Show a => FovValid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FovValid a] -> ShowS
$cshowList :: forall a. Show a => [FovValid a] -> ShowS
show :: FovValid a -> String
$cshow :: forall a. Show a => FovValid a -> String
showsPrec :: Int -> FovValid a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FovValid a -> ShowS
Show, FovValid a -> FovValid a -> Bool
(FovValid a -> FovValid a -> Bool)
-> (FovValid a -> FovValid a -> Bool) -> Eq (FovValid a)
forall a. Eq a => FovValid a -> FovValid a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FovValid a -> FovValid a -> Bool
$c/= :: forall a. Eq a => FovValid a -> FovValid a -> Bool
== :: FovValid a -> FovValid a -> Bool
$c== :: forall a. Eq a => FovValid a -> FovValid a -> Bool
Eq)

-- | Main perception validity map, for all factions.
--
-- The inner type is not a set, due to an unbenchmarked theory
-- that a constant shape map is faster.
type PerValidFid = EM.EnumMap FactionId (EM.EnumMap LevelId Bool)

-- | Visually reachable positions (light passes through them to the actor).
-- They need to be intersected with lucid positions to obtain visible positions.
newtype PerReachable = PerReachable {PerReachable -> EnumSet Point
preachable :: ES.EnumSet Point}
  deriving (Int -> PerReachable -> ShowS
[PerReachable] -> ShowS
PerReachable -> String
(Int -> PerReachable -> ShowS)
-> (PerReachable -> String)
-> ([PerReachable] -> ShowS)
-> Show PerReachable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerReachable] -> ShowS
$cshowList :: [PerReachable] -> ShowS
show :: PerReachable -> String
$cshow :: PerReachable -> String
showsPrec :: Int -> PerReachable -> ShowS
$cshowsPrec :: Int -> PerReachable -> ShowS
Show, PerReachable -> PerReachable -> Bool
(PerReachable -> PerReachable -> Bool)
-> (PerReachable -> PerReachable -> Bool) -> Eq PerReachable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerReachable -> PerReachable -> Bool
$c/= :: PerReachable -> PerReachable -> Bool
== :: PerReachable -> PerReachable -> Bool
$c== :: PerReachable -> PerReachable -> Bool
Eq)

data CacheBeforeLucid = CacheBeforeLucid
  { CacheBeforeLucid -> PerReachable
creachable :: PerReachable
  , CacheBeforeLucid -> PerVisible
cnocto     :: PerVisible
  , CacheBeforeLucid -> PerSmelled
csmell     :: PerSmelled
  }
  deriving (Int -> CacheBeforeLucid -> ShowS
[CacheBeforeLucid] -> ShowS
CacheBeforeLucid -> String
(Int -> CacheBeforeLucid -> ShowS)
-> (CacheBeforeLucid -> String)
-> ([CacheBeforeLucid] -> ShowS)
-> Show CacheBeforeLucid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheBeforeLucid] -> ShowS
$cshowList :: [CacheBeforeLucid] -> ShowS
show :: CacheBeforeLucid -> String
$cshow :: CacheBeforeLucid -> String
showsPrec :: Int -> CacheBeforeLucid -> ShowS
$cshowsPrec :: Int -> CacheBeforeLucid -> ShowS
Show, CacheBeforeLucid -> CacheBeforeLucid -> Bool
(CacheBeforeLucid -> CacheBeforeLucid -> Bool)
-> (CacheBeforeLucid -> CacheBeforeLucid -> Bool)
-> Eq CacheBeforeLucid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheBeforeLucid -> CacheBeforeLucid -> Bool
$c/= :: CacheBeforeLucid -> CacheBeforeLucid -> Bool
== :: CacheBeforeLucid -> CacheBeforeLucid -> Bool
$c== :: CacheBeforeLucid -> CacheBeforeLucid -> Bool
Eq)

type PerActor = EM.EnumMap ActorId (FovValid CacheBeforeLucid)

-- We might cache even more effectively in terms of Enum{Set,Map} unions
-- if we recorded for each field how many actors see it (and how many
-- lights lit it). But this is complex and unions of EnumSets are cheaper
-- than the EnumMaps that would be required.
data PerceptionCache = PerceptionCache
  { PerceptionCache -> FovValid CacheBeforeLucid
ptotal   :: FovValid CacheBeforeLucid
  , PerceptionCache -> PerActor
perActor :: PerActor
  }
  deriving (Int -> PerceptionCache -> ShowS
[PerceptionCache] -> ShowS
PerceptionCache -> String
(Int -> PerceptionCache -> ShowS)
-> (PerceptionCache -> String)
-> ([PerceptionCache] -> ShowS)
-> Show PerceptionCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerceptionCache] -> ShowS
$cshowList :: [PerceptionCache] -> ShowS
show :: PerceptionCache -> String
$cshow :: PerceptionCache -> String
showsPrec :: Int -> PerceptionCache -> ShowS
$cshowsPrec :: Int -> PerceptionCache -> ShowS
Show, PerceptionCache -> PerceptionCache -> Bool
(PerceptionCache -> PerceptionCache -> Bool)
-> (PerceptionCache -> PerceptionCache -> Bool)
-> Eq PerceptionCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerceptionCache -> PerceptionCache -> Bool
$c/= :: PerceptionCache -> PerceptionCache -> Bool
== :: PerceptionCache -> PerceptionCache -> Bool
$c== :: PerceptionCache -> PerceptionCache -> Bool
Eq)

-- | Server cache of perceptions of a single faction,
-- indexed by level identifier.
type PerCacheLid = EM.EnumMap LevelId PerceptionCache

-- | Server cache of perceptions, indexed by faction identifier.
type PerCacheFid = EM.EnumMap FactionId PerCacheLid

-- * Data used in FOV computation

-- | Map from level positions that currently hold item or actor(s) with shine
-- to the maximum of radiuses of the shining lights.
--
-- Note that floor and (many projectile) actors light on a single tile
-- should be additive for @FovShine@ to be incrementally updated.
--
-- @FovShine@ should not even be kept in @StateServer@, because it's cheap
-- to compute, compared to @FovLucid@ and invalidated almost as often
-- (not invalidated only by @UpdAlterTile@).
newtype FovShine = FovShine {FovShine -> EnumMap Point Int
fovShine :: EM.EnumMap Point Int}
  deriving (Int -> FovShine -> ShowS
[FovShine] -> ShowS
FovShine -> String
(Int -> FovShine -> ShowS)
-> (FovShine -> String) -> ([FovShine] -> ShowS) -> Show FovShine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FovShine] -> ShowS
$cshowList :: [FovShine] -> ShowS
show :: FovShine -> String
$cshow :: FovShine -> String
showsPrec :: Int -> FovShine -> ShowS
$cshowsPrec :: Int -> FovShine -> ShowS
Show, FovShine -> FovShine -> Bool
(FovShine -> FovShine -> Bool)
-> (FovShine -> FovShine -> Bool) -> Eq FovShine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FovShine -> FovShine -> Bool
$c/= :: FovShine -> FovShine -> Bool
== :: FovShine -> FovShine -> Bool
$c== :: FovShine -> FovShine -> Bool
Eq)

-- | Level positions with either ambient light or shining items or actors.
newtype FovLucid = FovLucid {FovLucid -> EnumSet Point
fovLucid :: ES.EnumSet Point}
  deriving (Int -> FovLucid -> ShowS
[FovLucid] -> ShowS
FovLucid -> String
(Int -> FovLucid -> ShowS)
-> (FovLucid -> String) -> ([FovLucid] -> ShowS) -> Show FovLucid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FovLucid] -> ShowS
$cshowList :: [FovLucid] -> ShowS
show :: FovLucid -> String
$cshow :: FovLucid -> String
showsPrec :: Int -> FovLucid -> ShowS
$cshowsPrec :: Int -> FovLucid -> ShowS
Show, FovLucid -> FovLucid -> Bool
(FovLucid -> FovLucid -> Bool)
-> (FovLucid -> FovLucid -> Bool) -> Eq FovLucid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FovLucid -> FovLucid -> Bool
$c/= :: FovLucid -> FovLucid -> Bool
== :: FovLucid -> FovLucid -> Bool
$c== :: FovLucid -> FovLucid -> Bool
Eq)

type FovLucidLid = EM.EnumMap LevelId (FovValid FovLucid)

-- | Level positions that pass through light and vision.
newtype FovClear = FovClear {FovClear -> Array Bool
fovClear :: PointArray.Array Bool}
  deriving (Int -> FovClear -> ShowS
[FovClear] -> ShowS
FovClear -> String
(Int -> FovClear -> ShowS)
-> (FovClear -> String) -> ([FovClear] -> ShowS) -> Show FovClear
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FovClear] -> ShowS
$cshowList :: [FovClear] -> ShowS
show :: FovClear -> String
$cshow :: FovClear -> String
showsPrec :: Int -> FovClear -> ShowS
$cshowsPrec :: Int -> FovClear -> ShowS
Show, FovClear -> FovClear -> Bool
(FovClear -> FovClear -> Bool)
-> (FovClear -> FovClear -> Bool) -> Eq FovClear
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FovClear -> FovClear -> Bool
$c/= :: FovClear -> FovClear -> Bool
== :: FovClear -> FovClear -> Bool
$c== :: FovClear -> FovClear -> Bool
Eq)

type FovClearLid = EM.EnumMap LevelId FovClear

-- | Level positions with tiles that have ambient light.
newtype FovLit = FovLit {FovLit -> EnumSet Point
fovLit :: ES.EnumSet Point}
  deriving (Int -> FovLit -> ShowS
[FovLit] -> ShowS
FovLit -> String
(Int -> FovLit -> ShowS)
-> (FovLit -> String) -> ([FovLit] -> ShowS) -> Show FovLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FovLit] -> ShowS
$cshowList :: [FovLit] -> ShowS
show :: FovLit -> String
$cshow :: FovLit -> String
showsPrec :: Int -> FovLit -> ShowS
$cshowsPrec :: Int -> FovLit -> ShowS
Show, FovLit -> FovLit -> Bool
(FovLit -> FovLit -> Bool)
-> (FovLit -> FovLit -> Bool) -> Eq FovLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FovLit -> FovLit -> Bool
$c/= :: FovLit -> FovLit -> Bool
== :: FovLit -> FovLit -> Bool
$c== :: FovLit -> FovLit -> Bool
Eq)

type FovLitLid = EM.EnumMap LevelId FovLit

-- * Update of invalidated Fov data

-- | Compute positions visible (reachable and seen) by the party.
-- A position is lucid, if it's lit by an ambient light or by a weak, portable
-- light source, e.g,, carried by an actor. A reachable and lucid position
-- is visible. Additionally, positions directly adjacent to an actor are
-- assumed to be visible to him (through sound, touch, noctovision, whatever).
perceptionFromPTotal :: FactionId -> LevelId
                     -> FovLucid -> CacheBeforeLucid -> State
                     -> Perception
perceptionFromPTotal :: FactionId
-> LevelId -> FovLucid -> CacheBeforeLucid -> State -> Perception
perceptionFromPTotal FactionId
fid LevelId
lidPer FovLucid
fovLucid CacheBeforeLucid
ptotal State
s =
  let per :: Perception
per = FovLucid -> CacheBeforeLucid -> Perception
perceptionFromPTotalNoStash FovLucid
fovLucid CacheBeforeLucid
ptotal
  in case Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid of
       Just (LevelId
lid, Point
pos) | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidPer ->
         Perception
per {psight :: PerVisible
psight = (Perception -> PerVisible
psight Perception
per) {pvisible :: EnumSet Point
pvisible = Point -> EnumSet Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert Point
pos
                                                (EnumSet Point -> EnumSet Point) -> EnumSet Point -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ PerVisible -> EnumSet Point
pvisible (Perception -> PerVisible
psight Perception
per)}}
       Maybe (LevelId, Point)
_ -> Perception
per

perceptionFromPTotalNoStash :: FovLucid -> CacheBeforeLucid -> Perception
perceptionFromPTotalNoStash :: FovLucid -> CacheBeforeLucid -> Perception
perceptionFromPTotalNoStash FovLucid{EnumSet Point
fovLucid :: EnumSet Point
fovLucid :: FovLucid -> EnumSet Point
fovLucid} CacheBeforeLucid
ptotal =
  let nocto :: EnumSet Point
nocto = PerVisible -> EnumSet Point
pvisible (PerVisible -> EnumSet Point) -> PerVisible -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ CacheBeforeLucid -> PerVisible
cnocto CacheBeforeLucid
ptotal
      reach :: EnumSet Point
reach = PerReachable -> EnumSet Point
preachable (PerReachable -> EnumSet Point) -> PerReachable -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ CacheBeforeLucid -> PerReachable
creachable CacheBeforeLucid
ptotal
      psight :: PerVisible
psight = EnumSet Point -> PerVisible
PerVisible (EnumSet Point -> PerVisible) -> EnumSet Point -> PerVisible
forall a b. (a -> b) -> a -> b
$ EnumSet Point
nocto EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
`ES.union` (EnumSet Point
reach EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
`ES.intersection` EnumSet Point
fovLucid)
      psmell :: PerSmelled
psmell = CacheBeforeLucid -> PerSmelled
csmell CacheBeforeLucid
ptotal
  in Perception :: PerVisible -> PerSmelled -> Perception
Perception{PerSmelled
PerVisible
psmell :: PerSmelled
psmell :: PerSmelled
psight :: PerVisible
psight :: PerVisible
..}

perActorFromLevel :: PerActor -> (ActorId -> Actor)
                  -> ActorMaxSkills -> FovClear
                  -> PerActor
perActorFromLevel :: PerActor
-> (ActorId -> Actor) -> ActorMaxSkills -> FovClear -> PerActor
perActorFromLevel PerActor
perActorOld ActorId -> Actor
getActorB ActorMaxSkills
actorMaxSkills FovClear
fovClear =
  -- Dying actors included, to let them see their own demise.
  let f :: ActorId -> FovValid CacheBeforeLucid -> FovValid CacheBeforeLucid
f ActorId
_ fv :: FovValid CacheBeforeLucid
fv@FovValid{} = FovValid CacheBeforeLucid
fv
      f ActorId
aid FovValid CacheBeforeLucid
FovInvalid =
        let actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
            b :: Actor
b = ActorId -> Actor
getActorB ActorId
aid
        in CacheBeforeLucid -> FovValid CacheBeforeLucid
forall a. a -> FovValid a
FovValid (CacheBeforeLucid -> FovValid CacheBeforeLucid)
-> CacheBeforeLucid -> FovValid CacheBeforeLucid
forall a b. (a -> b) -> a -> b
$ FovClear -> Actor -> Skills -> CacheBeforeLucid
cacheBeforeLucidFromActor FovClear
fovClear Actor
b Skills
actorMaxSk
  in (ActorId -> FovValid CacheBeforeLucid -> FovValid CacheBeforeLucid)
-> PerActor -> PerActor
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey ActorId -> FovValid CacheBeforeLucid -> FovValid CacheBeforeLucid
f PerActor
perActorOld

boundSightByCalm :: Int -> Int64 -> Int
boundSightByCalm :: Int -> Int64 -> Int
boundSightByCalm Int
sight Int64
calm = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64
calm Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int -> Int64
xM Int
5) Int
sight

-- | Compute positions reachable by the actor. Reachable are all fields
-- on a visually unblocked path from the actor position.
-- Also compute positions seen by noctovision and perceived by smell.
cacheBeforeLucidFromActor :: FovClear -> Actor -> Ability.Skills
                          -> CacheBeforeLucid
cacheBeforeLucidFromActor :: FovClear -> Actor -> Skills -> CacheBeforeLucid
cacheBeforeLucidFromActor FovClear
clearPs Actor
body Skills
actorMaxSk =
  let radius :: Int
radius =
        Int -> Int64 -> Int
boundSightByCalm (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk) (Actor -> Int64
bcalm Actor
body)
      spectatorPos :: Point
spectatorPos = Actor -> Point
bpos Actor
body
      creachable :: PerReachable
creachable = EnumSet Point -> PerReachable
PerReachable (EnumSet Point -> PerReachable) -> EnumSet Point -> PerReachable
forall a b. (a -> b) -> a -> b
$ Int -> Point -> FovClear -> EnumSet Point
fullscan Int
radius Point
spectatorPos FovClear
clearPs
      cnocto :: PerVisible
cnocto = EnumSet Point -> PerVisible
PerVisible (EnumSet Point -> PerVisible) -> EnumSet Point -> PerVisible
forall a b. (a -> b) -> a -> b
$ Int -> Point -> FovClear -> EnumSet Point
fullscan (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk)
                                     Point
spectatorPos
                                     FovClear
clearPs
      smellRadius :: Int
smellRadius =
        if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 then Int
2 else Int
0
      csmell :: PerSmelled
csmell = EnumSet Point -> PerSmelled
PerSmelled (EnumSet Point -> PerSmelled) -> EnumSet Point -> PerSmelled
forall a b. (a -> b) -> a -> b
$ Int -> Point -> FovClear -> EnumSet Point
fullscan Int
smellRadius Point
spectatorPos FovClear
clearPs
  in CacheBeforeLucid :: PerReachable -> PerVisible -> PerSmelled -> CacheBeforeLucid
CacheBeforeLucid{PerSmelled
PerVisible
PerReachable
csmell :: PerSmelled
cnocto :: PerVisible
creachable :: PerReachable
csmell :: PerSmelled
cnocto :: PerVisible
creachable :: PerReachable
..}

totalFromPerActor :: PerActor -> CacheBeforeLucid
totalFromPerActor :: PerActor -> CacheBeforeLucid
totalFromPerActor PerActor
perActor =
  let fromValid :: FovValid CacheBeforeLucid -> CacheBeforeLucid
fromValid = \case
        FovValid CacheBeforeLucid
x -> CacheBeforeLucid
x
        FovValid CacheBeforeLucid
FovInvalid -> String -> CacheBeforeLucid
forall a. HasCallStack => String -> a
error (String -> CacheBeforeLucid) -> String -> CacheBeforeLucid
forall a b. (a -> b) -> a -> b
$ String
"" String -> PerActor -> String
forall v. Show v => String -> v -> String
`showFailure` PerActor
perActor
      addCacheBeforeLucid :: FovValid CacheBeforeLucid -> CacheBeforeLucid -> CacheBeforeLucid
addCacheBeforeLucid FovValid CacheBeforeLucid
x CacheBeforeLucid
cbl1 =
        let cbl2 :: CacheBeforeLucid
cbl2 = FovValid CacheBeforeLucid -> CacheBeforeLucid
fromValid FovValid CacheBeforeLucid
x
        in CacheBeforeLucid :: PerReachable -> PerVisible -> PerSmelled -> CacheBeforeLucid
CacheBeforeLucid
          { creachable :: PerReachable
creachable = EnumSet Point -> PerReachable
PerReachable
                         (EnumSet Point -> PerReachable) -> EnumSet Point -> PerReachable
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union (PerReachable -> EnumSet Point
preachable (PerReachable -> EnumSet Point) -> PerReachable -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ CacheBeforeLucid -> PerReachable
creachable CacheBeforeLucid
cbl1)
                                    (PerReachable -> EnumSet Point
preachable (PerReachable -> EnumSet Point) -> PerReachable -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ CacheBeforeLucid -> PerReachable
creachable CacheBeforeLucid
cbl2)
          , cnocto :: PerVisible
cnocto = EnumSet Point -> PerVisible
PerVisible
                     (EnumSet Point -> PerVisible) -> EnumSet Point -> PerVisible
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union (PerVisible -> EnumSet Point
pvisible (PerVisible -> EnumSet Point) -> PerVisible -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ CacheBeforeLucid -> PerVisible
cnocto CacheBeforeLucid
cbl1)
                                (PerVisible -> EnumSet Point
pvisible (PerVisible -> EnumSet Point) -> PerVisible -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ CacheBeforeLucid -> PerVisible
cnocto CacheBeforeLucid
cbl2)
          , csmell :: PerSmelled
csmell = EnumSet Point -> PerSmelled
PerSmelled
                     (EnumSet Point -> PerSmelled) -> EnumSet Point -> PerSmelled
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union (PerSmelled -> EnumSet Point
psmelled (PerSmelled -> EnumSet Point) -> PerSmelled -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ CacheBeforeLucid -> PerSmelled
csmell CacheBeforeLucid
cbl1)
                                (PerSmelled -> EnumSet Point
psmelled (PerSmelled -> EnumSet Point) -> PerSmelled -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ CacheBeforeLucid -> PerSmelled
csmell CacheBeforeLucid
cbl2)
          }
      emptyCacheBeforeLucid :: CacheBeforeLucid
emptyCacheBeforeLucid = CacheBeforeLucid :: PerReachable -> PerVisible -> PerSmelled -> CacheBeforeLucid
CacheBeforeLucid
        { creachable :: PerReachable
creachable = EnumSet Point -> PerReachable
PerReachable EnumSet Point
forall k. EnumSet k
ES.empty
        , cnocto :: PerVisible
cnocto = EnumSet Point -> PerVisible
PerVisible EnumSet Point
forall k. EnumSet k
ES.empty
        , csmell :: PerSmelled
csmell = EnumSet Point -> PerSmelled
PerSmelled EnumSet Point
forall k. EnumSet k
ES.empty }
  in (FovValid CacheBeforeLucid -> CacheBeforeLucid -> CacheBeforeLucid)
-> CacheBeforeLucid
-> [FovValid CacheBeforeLucid]
-> CacheBeforeLucid
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FovValid CacheBeforeLucid -> CacheBeforeLucid -> CacheBeforeLucid
addCacheBeforeLucid CacheBeforeLucid
emptyCacheBeforeLucid ([FovValid CacheBeforeLucid] -> CacheBeforeLucid)
-> [FovValid CacheBeforeLucid] -> CacheBeforeLucid
forall a b. (a -> b) -> a -> b
$ PerActor -> [FovValid CacheBeforeLucid]
forall k a. EnumMap k a -> [a]
EM.elems PerActor
perActor

-- | Update lights on the level. This is needed every (even enemy)
-- actor move to show thrown torches.
-- We need to update lights even if cmd doesn't change any perception,
-- so that for next cmd that does, but doesn't change lights,
-- and operates on the same level, the lights are up to date.
-- We could make lights lazy to ensure no computation is wasted,
-- but it's rare that cmd changed them, but not the perception
-- (e.g., earthquake in an uninhabited corner of the active arena,
-- but the we'd probably want some feedback, at least sound).
lucidFromLevel :: FovClearLid -> FovLitLid -> State -> LevelId -> Level
               -> FovLucid
lucidFromLevel :: FovClearLid -> FovLitLid -> State -> LevelId -> Level -> FovLucid
lucidFromLevel FovClearLid
fovClearLid FovLitLid
fovLitLid State
s LevelId
lid Level
lvl =
  let shine :: FovShine
shine = State -> LevelId -> Level -> FovShine
shineFromLevel State
s LevelId
lid Level
lvl
      lucids :: [FovLucid]
lucids = FovClear -> [(Point, Int)] -> [FovLucid]
lucidFromItems (FovClearLid
fovClearLid FovClearLid -> LevelId -> FovClear
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid)
               ([(Point, Int)] -> [FovLucid]) -> [(Point, Int)] -> [FovLucid]
forall a b. (a -> b) -> a -> b
$ EnumMap Point Int -> [(Point, Int)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap Point Int -> [(Point, Int)])
-> EnumMap Point Int -> [(Point, Int)]
forall a b. (a -> b) -> a -> b
$ FovShine -> EnumMap Point Int
fovShine FovShine
shine
      litTiles :: FovLit
litTiles = FovLitLid
fovLitLid FovLitLid -> LevelId -> FovLit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
  in EnumSet Point -> FovLucid
FovLucid (EnumSet Point -> FovLucid) -> EnumSet Point -> FovLucid
forall a b. (a -> b) -> a -> b
$ [EnumSet Point] -> EnumSet Point
forall k. [EnumSet k] -> EnumSet k
ES.unions ([EnumSet Point] -> EnumSet Point)
-> [EnumSet Point] -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ FovLit -> EnumSet Point
fovLit FovLit
litTiles EnumSet Point -> [EnumSet Point] -> [EnumSet Point]
forall a. a -> [a] -> [a]
: (FovLucid -> EnumSet Point) -> [FovLucid] -> [EnumSet Point]
forall a b. (a -> b) -> [a] -> [b]
map FovLucid -> EnumSet Point
fovLucid [FovLucid]
lucids

shineFromLevel :: State -> LevelId -> Level -> FovShine
shineFromLevel :: State -> LevelId -> Level -> FovShine
shineFromLevel State
s LevelId
lid Level
lvl =
  -- Actors shine as if they were leaders, for speed and to prevent
  -- micromanagement by switching leader to see more.
  let actorLights :: [(Point, Int)]
actorLights =
        [ (Actor -> Point
bpos Actor
b, Int
radius)
        | (ActorId
aid, Actor
b) <- ((FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)])
-> (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
forall a. a -> a
inline (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (Bool -> FactionId -> Bool
forall a b. a -> b -> a
const Bool
True) LevelId
lid State
s
        , let radius :: Int
radius = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkShine (Skills -> Int) -> Skills -> Int
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid State
s
        , Int
radius Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]
      floorLights :: [(Point, Int)]
floorLights = DiscoveryAspect -> Level -> [(Point, Int)]
floorLightSources (State -> DiscoveryAspect
sdiscoAspect State
s) Level
lvl
      allLights :: [(Point, Int)]
allLights = [(Point, Int)]
floorLights [(Point, Int)] -> [(Point, Int)] -> [(Point, Int)]
forall a. [a] -> [a] -> [a]
++ [(Point, Int)]
actorLights
      -- If there is light both on the floor and carried by actor
      -- (or several projectile actors), its radius is the maximum.
  in EnumMap Point Int -> FovShine
FovShine (EnumMap Point Int -> FovShine) -> EnumMap Point Int -> FovShine
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [(Point, Int)] -> EnumMap Point Int
forall k a. Enum k => (a -> a -> a) -> [(k, a)] -> EnumMap k a
EM.fromListWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max [(Point, Int)]
allLights

floorLightSources :: DiscoveryAspect -> Level -> [(Point, Int)]
floorLightSources :: DiscoveryAspect -> Level -> [(Point, Int)]
floorLightSources DiscoveryAspect
discoAspect Level
lvl =
  -- Not enough oxygen to have more than one light lit on a given tile.
  -- Items obscuring or dousing off fire are not cumulative as well.
  let processIid :: (Int, Int) -> (ItemId, ItemQuant) -> (Int, Int)
processIid (Int
accLight, Int
accDouse) (ItemId
iid, ItemQuant
_) =
        let shine :: Int
shine = Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkShine (AspectRecord -> Int) -> AspectRecord -> Int
forall a b. (a -> b) -> a -> b
$ DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
        in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
shine Int
0 of
          Ordering
EQ -> (Int
accLight, Int
accDouse)
          Ordering
GT -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
shine Int
accLight, Int
accDouse)
          Ordering
LT -> (Int
accLight, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
shine Int
accDouse)
      processBag :: EnumMap ItemId ItemQuant -> (Int, Int) -> (Int, Int)
processBag EnumMap ItemId ItemQuant
bag (Int, Int)
acc = ((Int, Int) -> (ItemId, ItemQuant) -> (Int, Int))
-> (Int, Int) -> [(ItemId, ItemQuant)] -> (Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int) -> (ItemId, ItemQuant) -> (Int, Int)
processIid (Int, Int)
acc ([(ItemId, ItemQuant)] -> (Int, Int))
-> [(ItemId, ItemQuant)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ItemId ItemQuant
bag
  in [ (Point
p, Int
radius)
     | (Point
p, EnumMap ItemId ItemQuant
bag) <- EnumMap Point (EnumMap ItemId ItemQuant)
-> [(Point, EnumMap ItemId ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap Point (EnumMap ItemId ItemQuant)
 -> [(Point, EnumMap ItemId ItemQuant)])
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> [(Point, EnumMap ItemId ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point (EnumMap ItemId ItemQuant)
lfloor Level
lvl  -- lembed are hidden
     , let (Int
maxLight, Int
maxDouse) = EnumMap ItemId ItemQuant -> (Int, Int) -> (Int, Int)
processBag EnumMap ItemId ItemQuant
bag (Int
0, Int
0)
           radius :: Int
radius = Int
maxLight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxDouse
     , Int
radius Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]

-- | Compute all dynamically lit positions on a level, whether lit by actors
-- or shining floor items. Note that an actor can be blind,
-- in which case he doesn't see his own light (but others,
-- from his or other factions, possibly do).
lucidFromItems :: FovClear -> [(Point, Int)] -> [FovLucid]
lucidFromItems :: FovClear -> [(Point, Int)] -> [FovLucid]
lucidFromItems FovClear
clearPs [(Point, Int)]
allItems =
  let lucidPos :: (Point, Int) -> FovLucid
lucidPos (!Point
p, !Int
shine) = EnumSet Point -> FovLucid
FovLucid (EnumSet Point -> FovLucid) -> EnumSet Point -> FovLucid
forall a b. (a -> b) -> a -> b
$ Int -> Point -> FovClear -> EnumSet Point
fullscan Int
shine Point
p FovClear
clearPs
  in ((Point, Int) -> FovLucid) -> [(Point, Int)] -> [FovLucid]
forall a b. (a -> b) -> [a] -> [b]
map (Point, Int) -> FovLucid
lucidPos [(Point, Int)]
allItems

-- * Computation of initial perception and caches

-- | Calculate the perception and its caches for the whole dungeon.
perFidInDungeon :: State -> ( FovLitLid, FovClearLid, FovLucidLid
                            , PerValidFid, PerCacheFid, PerFid)
perFidInDungeon :: State
-> (FovLitLid, FovClearLid, FovLucidLid, PerValidFid, PerCacheFid,
    PerFid)
perFidInDungeon State
s =
  let fovLitLid :: FovLitLid
fovLitLid = State -> FovLitLid
litInDungeon State
s
      fovClearLid :: FovClearLid
fovClearLid = State -> FovClearLid
clearInDungeon State
s
      fovLucidLid :: FovLucidLid
fovLucidLid = FovClearLid -> FovLitLid -> State -> FovLucidLid
lucidInDungeon FovClearLid
fovClearLid FovLitLid
fovLitLid State
s
      perValidLid :: EnumMap LevelId Bool
perValidLid = (Level -> Bool) -> EnumMap LevelId Level -> EnumMap LevelId Bool
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Bool -> Level -> Bool
forall a b. a -> b -> a
const Bool
True) (State -> EnumMap LevelId Level
sdungeon State
s)
      perValidFid :: PerValidFid
perValidFid = (Faction -> EnumMap LevelId Bool) -> FactionDict -> PerValidFid
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (EnumMap LevelId Bool -> Faction -> EnumMap LevelId Bool
forall a b. a -> b -> a
const EnumMap LevelId Bool
perValidLid) (State -> FactionDict
sfactionD State
s)
      f :: FactionId -> Faction -> (PerLid, PerCacheLid)
f FactionId
fid Faction
_ = FovLucidLid
-> FovClearLid -> FactionId -> State -> (PerLid, PerCacheLid)
perLidFromFaction FovLucidLid
fovLucidLid FovClearLid
fovClearLid FactionId
fid State
s
      em :: EnumMap FactionId (PerLid, PerCacheLid)
em = (FactionId -> Faction -> (PerLid, PerCacheLid))
-> FactionDict -> EnumMap FactionId (PerLid, PerCacheLid)
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey FactionId -> Faction -> (PerLid, PerCacheLid)
f (FactionDict -> EnumMap FactionId (PerLid, PerCacheLid))
-> FactionDict -> EnumMap FactionId (PerLid, PerCacheLid)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s
  in ( FovLitLid
fovLitLid, FovClearLid
fovClearLid, FovLucidLid
fovLucidLid
     , PerValidFid
perValidFid, ((PerLid, PerCacheLid) -> PerCacheLid)
-> EnumMap FactionId (PerLid, PerCacheLid) -> PerCacheFid
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (PerLid, PerCacheLid) -> PerCacheLid
forall a b. (a, b) -> b
snd EnumMap FactionId (PerLid, PerCacheLid)
em, ((PerLid, PerCacheLid) -> PerLid)
-> EnumMap FactionId (PerLid, PerCacheLid) -> PerFid
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (PerLid, PerCacheLid) -> PerLid
forall a b. (a, b) -> a
fst EnumMap FactionId (PerLid, PerCacheLid)
em)

litFromLevel :: COps -> Level -> FovLit
litFromLevel :: COps -> Level -> FovLit
litFromLevel COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} Level{TileMap
ltile :: Level -> TileMap
ltile :: TileMap
ltile} =
  let litSet :: Point -> ContentId TileKind -> [Point] -> [Point]
litSet Point
p ContentId TileKind
t [Point]
set = if TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup ContentId TileKind
t then Point
p Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
set else [Point]
set
  in EnumSet Point -> FovLit
FovLit (EnumSet Point -> FovLit) -> EnumSet Point -> FovLit
forall a b. (a -> b) -> a -> b
$ [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList ([Point] -> EnumSet Point) -> [Point] -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ (Point -> ContentId TileKind -> [Point] -> [Point])
-> [Point] -> TileMap -> [Point]
forall c a.
UnboxRepClass c =>
(Point -> c -> a -> a) -> a -> Array c -> a
PointArray.ifoldrA' Point -> ContentId TileKind -> [Point] -> [Point]
litSet [] TileMap
ltile

litInDungeon :: State -> FovLitLid
litInDungeon :: State -> FovLitLid
litInDungeon State
s = (Level -> FovLit) -> EnumMap LevelId Level -> FovLitLid
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (COps -> Level -> FovLit
litFromLevel (State -> COps
scops State
s)) (EnumMap LevelId Level -> FovLitLid)
-> EnumMap LevelId Level -> FovLitLid
forall a b. (a -> b) -> a -> b
$ State -> EnumMap LevelId Level
sdungeon State
s

clearFromLevel :: COps -> Level -> FovClear
clearFromLevel :: COps -> Level -> FovClear
clearFromLevel COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} Level{TileMap
ltile :: TileMap
ltile :: Level -> TileMap
ltile} =
  Array Bool -> FovClear
FovClear (Array Bool -> FovClear) -> Array Bool -> FovClear
forall a b. (a -> b) -> a -> b
$ (ContentId TileKind -> Bool) -> TileMap -> Array Bool
forall c d.
(UnboxRepClass c, UnboxRepClass d) =>
(c -> d) -> Array c -> Array d
PointArray.mapA (TileSpeedup -> ContentId TileKind -> Bool
Tile.isClear TileSpeedup
coTileSpeedup) TileMap
ltile

clearInDungeon :: State -> FovClearLid
clearInDungeon :: State -> FovClearLid
clearInDungeon State
s = (Level -> FovClear) -> EnumMap LevelId Level -> FovClearLid
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (COps -> Level -> FovClear
clearFromLevel (State -> COps
scops State
s)) (EnumMap LevelId Level -> FovClearLid)
-> EnumMap LevelId Level -> FovClearLid
forall a b. (a -> b) -> a -> b
$ State -> EnumMap LevelId Level
sdungeon State
s

lucidInDungeon :: FovClearLid -> FovLitLid -> State -> FovLucidLid
lucidInDungeon :: FovClearLid -> FovLitLid -> State -> FovLucidLid
lucidInDungeon FovClearLid
fovClearLid FovLitLid
fovLitLid State
s =
  (LevelId -> Level -> FovValid FovLucid)
-> EnumMap LevelId Level -> FovLucidLid
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey
    (\LevelId
lid Level
lvl -> FovLucid -> FovValid FovLucid
forall a. a -> FovValid a
FovValid (FovLucid -> FovValid FovLucid) -> FovLucid -> FovValid FovLucid
forall a b. (a -> b) -> a -> b
$ FovClearLid -> FovLitLid -> State -> LevelId -> Level -> FovLucid
lucidFromLevel FovClearLid
fovClearLid FovLitLid
fovLitLid State
s LevelId
lid Level
lvl)
    (EnumMap LevelId Level -> FovLucidLid)
-> EnumMap LevelId Level -> FovLucidLid
forall a b. (a -> b) -> a -> b
$ State -> EnumMap LevelId Level
sdungeon State
s

-- | Calculate perception of a faction.
perLidFromFaction :: FovLucidLid -> FovClearLid -> FactionId -> State
                  -> (PerLid, PerCacheLid)
perLidFromFaction :: FovLucidLid
-> FovClearLid -> FactionId -> State -> (PerLid, PerCacheLid)
perLidFromFaction FovLucidLid
fovLucidLid FovClearLid
fovClearLid FactionId
fid State
s =
  let em :: PerCacheLid
em = (LevelId -> Level -> PerceptionCache)
-> EnumMap LevelId Level -> PerCacheLid
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey (\LevelId
lid Level
_ ->
                            FovClearLid -> FactionId -> LevelId -> State -> PerceptionCache
perceptionCacheFromLevel FovClearLid
fovClearLid FactionId
fid LevelId
lid State
s)
                         (State -> EnumMap LevelId Level
sdungeon State
s)
      fovLucid :: LevelId -> FovLucid
fovLucid LevelId
lid = case LevelId -> FovLucidLid -> Maybe (FovValid FovLucid)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup LevelId
lid FovLucidLid
fovLucidLid of
        Just (FovValid FovLucid
fl) -> FovLucid
fl
        Maybe (FovValid FovLucid)
_ -> String -> FovLucid
forall a. HasCallStack => String -> a
error (String -> FovLucid) -> String -> FovLucid
forall a b. (a -> b) -> a -> b
$ String
"" String -> (LevelId, FovLucidLid) -> String
forall v. Show v => String -> v -> String
`showFailure` (LevelId
lid, FovLucidLid
fovLucidLid)
      getValid :: FovValid CacheBeforeLucid -> CacheBeforeLucid
getValid (FovValid CacheBeforeLucid
pc) = CacheBeforeLucid
pc
      getValid FovValid CacheBeforeLucid
FovInvalid = String -> CacheBeforeLucid
forall a. HasCallStack => String -> a
error (String -> CacheBeforeLucid) -> String -> CacheBeforeLucid
forall a b. (a -> b) -> a -> b
$ String
"" String -> FactionId -> String
forall v. Show v => String -> v -> String
`showFailure` FactionId
fid
      per :: LevelId -> PerceptionCache -> Perception
per LevelId
lid PerceptionCache
pc = FactionId
-> LevelId -> FovLucid -> CacheBeforeLucid -> State -> Perception
perceptionFromPTotal
                     FactionId
fid LevelId
lid (LevelId -> FovLucid
fovLucid LevelId
lid) (FovValid CacheBeforeLucid -> CacheBeforeLucid
getValid (PerceptionCache -> FovValid CacheBeforeLucid
ptotal PerceptionCache
pc)) State
s
  in ((LevelId -> PerceptionCache -> Perception) -> PerCacheLid -> PerLid
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey LevelId -> PerceptionCache -> Perception
per PerCacheLid
em, PerCacheLid
em)

perceptionCacheFromLevel :: FovClearLid -> FactionId -> LevelId -> State
                         -> PerceptionCache
perceptionCacheFromLevel :: FovClearLid -> FactionId -> LevelId -> State -> PerceptionCache
perceptionCacheFromLevel FovClearLid
fovClearLid FactionId
fid LevelId
lid State
s =
  let fovClear :: FovClear
fovClear = FovClearLid
fovClearLid FovClearLid -> LevelId -> FovClear
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
      lvlBodies :: [(ActorId, Actor)]
lvlBodies = ((FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)])
-> (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
forall a. a -> a
inline (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid) LevelId
lid State
s
      f :: (ActorId, Actor) -> Maybe (ActorId, FovValid CacheBeforeLucid)
f (ActorId
aid, Actor
b) =
        -- Actors see and smell as if they were leaders, for speed
        -- and to prevent micromanagement by switching leader to see more.
        let actorMaxSk :: Skills
actorMaxSk = ActorId -> State -> Skills
getActorMaxSkills ActorId
aid State
s
        in if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
              Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
              Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
           then Maybe (ActorId, FovValid CacheBeforeLucid)
forall a. Maybe a
Nothing  -- dumb missile
           else (ActorId, FovValid CacheBeforeLucid)
-> Maybe (ActorId, FovValid CacheBeforeLucid)
forall a. a -> Maybe a
Just (ActorId
aid, CacheBeforeLucid -> FovValid CacheBeforeLucid
forall a. a -> FovValid a
FovValid
                           (CacheBeforeLucid -> FovValid CacheBeforeLucid)
-> CacheBeforeLucid -> FovValid CacheBeforeLucid
forall a b. (a -> b) -> a -> b
$ FovClear -> Actor -> Skills -> CacheBeforeLucid
cacheBeforeLucidFromActor FovClear
fovClear Actor
b Skills
actorMaxSk)
      lvlCaches :: [(ActorId, FovValid CacheBeforeLucid)]
lvlCaches = ((ActorId, Actor) -> Maybe (ActorId, FovValid CacheBeforeLucid))
-> [(ActorId, Actor)] -> [(ActorId, FovValid CacheBeforeLucid)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ActorId, Actor) -> Maybe (ActorId, FovValid CacheBeforeLucid)
f [(ActorId, Actor)]
lvlBodies
      perActor :: PerActor
perActor = [(ActorId, FovValid CacheBeforeLucid)] -> PerActor
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList [(ActorId, FovValid CacheBeforeLucid)]
lvlCaches
      total :: CacheBeforeLucid
total = PerActor -> CacheBeforeLucid
totalFromPerActor PerActor
perActor
  in PerceptionCache :: FovValid CacheBeforeLucid -> PerActor -> PerceptionCache
PerceptionCache{ptotal :: FovValid CacheBeforeLucid
ptotal = CacheBeforeLucid -> FovValid CacheBeforeLucid
forall a. a -> FovValid a
FovValid CacheBeforeLucid
total, PerActor
perActor :: PerActor
perActor :: PerActor
perActor}

-- * The actual Fov algorithm

type Matrix = (Int, Int, Int, Int)

-- | Perform a full scan for a given position. Returns the positions
-- that are currently in the field of view.
-- The actor's own position is considred in his field of view.
fullscan :: Int       -- ^ scanning radius
         -> Point     -- ^ position of the spectator
         -> FovClear  -- ^ the array with clear positions
         -> ES.EnumSet Point
fullscan :: Int -> Point -> FovClear -> EnumSet Point
fullscan !Int
radius Point
spectatorPos FovClear
fc = case Int
radius of
  Int
2 -> Point -> EnumSet Point
squareUnsafeSet Point
spectatorPos
  Int
1 -> Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k
ES.singleton Point
spectatorPos
  Int
0 -> EnumSet Point
forall k. EnumSet k
ES.empty  -- e.g., smell for non-smelling
  Int
_ | Int
radius Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> EnumSet Point
forall k. EnumSet k
ES.empty
  Int
_ ->
    let !FovClear{Array Bool
fovClear :: Array Bool
fovClear :: FovClear -> Array Bool
fovClear} = FovClear
fc
        !spectatorI :: Int
spectatorI = Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
spectatorPos
        mapTr :: Matrix -> [PointI]
        mapTr :: Matrix -> [Int]
mapTr m :: Matrix
m@(!Int
_, !Int
_, !Int
_, !Int
_) = Int -> (Int -> Bool) -> (Bump -> Int) -> [Int]
scan (Int
radius Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Bool
isClear (Matrix -> Bump -> Int
trV Matrix
m)
        trV :: Matrix -> Bump -> PointI
        {-# INLINE trV #-}
        trV :: Matrix -> Bump -> Int
trV (Int
x1, Int
y1, Int
x2, Int
y2) B{Int
by :: Bump -> Int
bx :: Bump -> Int
by :: Int
bx :: Int
..} =
          Int
spectatorI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector -> Int
forall a. Enum a => a -> Int
fromEnum (Int -> Int -> Vector
Vector (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
by) (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
by))
        isClear :: PointI -> Bool
        {-# INLINE isClear #-}
        isClear :: Int -> Bool
isClear = Array Bool -> Int -> UnboxRep Bool
forall c. UnboxRepClass c => Array c -> Int -> UnboxRep c
PointArray.accessI Array Bool
fovClear
    in IntSet -> EnumSet Point
forall k. IntSet -> EnumSet k
ES.intSetToEnumSet (IntSet -> EnumSet Point) -> IntSet -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ [Int] -> IntSet
IS.fromList
       ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$ [Int
spectatorI]
         [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Matrix -> [Int]
mapTr (Int
1, Int
0, Int
0, -Int
1)   -- quadrant I
         [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Matrix -> [Int]
mapTr (Int
0, Int
1, Int
1, Int
0)    -- II (counter-clockwise)
         [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Matrix -> [Int]
mapTr (-Int
1, Int
0, Int
0, Int
1)   -- III
         [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Matrix -> [Int]
mapTr (Int
0, -Int
1, -Int
1, Int
0)  -- IV