-- | 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 fid :: FactionId
fid lidPer :: LevelId
lidPer fovLucid :: FovLucid
fovLucid ptotal :: CacheBeforeLucid
ptotal s :: 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 (lid :: LevelId
lid, pos :: 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)}}
       _ -> Perception
per

perceptionFromPTotalNoStash :: FovLucid -> CacheBeforeLucid -> Perception
perceptionFromPTotalNoStash :: FovLucid -> CacheBeforeLucid -> Perception
perceptionFromPTotalNoStash FovLucid{EnumSet Point
fovLucid :: EnumSet Point
fovLucid :: FovLucid -> EnumSet Point
fovLucid} ptotal :: 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 $WPerception :: PerVisible -> PerSmelled -> Perception
Perception{..}

perActorFromLevel :: PerActor -> (ActorId -> Actor)
                  -> ActorMaxSkills -> FovClear
                  -> PerActor
perActorFromLevel :: PerActor
-> (ActorId -> Actor) -> ActorMaxSkills -> FovClear -> PerActor
perActorFromLevel perActorOld :: PerActor
perActorOld getActorB :: ActorId -> Actor
getActorB actorMaxSkills :: ActorMaxSkills
actorMaxSkills fovClear :: FovClear
fovClear =
  -- Dying actors included, to let them see their own demise.
  let f :: ActorId -> FovValid CacheBeforeLucid -> FovValid CacheBeforeLucid
f _ fv :: FovValid CacheBeforeLucid
fv@FovValid{} = FovValid CacheBeforeLucid
fv
      f aid :: ActorId
aid 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 sight :: Int
sight calm :: 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 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 clearPs :: FovClear
clearPs body :: Actor
body actorMaxSk :: 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
>= 2 then 2 else 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 $WCacheBeforeLucid :: PerReachable -> PerVisible -> PerSmelled -> CacheBeforeLucid
CacheBeforeLucid{..}

totalFromPerActor :: PerActor -> CacheBeforeLucid
totalFromPerActor :: PerActor -> CacheBeforeLucid
totalFromPerActor perActor :: PerActor
perActor =
  let fromValid :: FovValid CacheBeforeLucid -> CacheBeforeLucid
fromValid = \case
        FovValid x :: CacheBeforeLucid
x -> CacheBeforeLucid
x
        FovInvalid -> String -> CacheBeforeLucid
forall a. HasCallStack => String -> a
error (String -> CacheBeforeLucid) -> String -> CacheBeforeLucid
forall a b. (a -> b) -> a -> b
$ "" String -> PerActor -> String
forall v. Show v => String -> v -> String
`showFailure` PerActor
perActor
      addCacheBeforeLucid :: FovValid CacheBeforeLucid -> CacheBeforeLucid -> CacheBeforeLucid
addCacheBeforeLucid x :: FovValid CacheBeforeLucid
x cbl1 :: CacheBeforeLucid
cbl1 =
        let cbl2 :: CacheBeforeLucid
cbl2 = FovValid CacheBeforeLucid -> CacheBeforeLucid
fromValid FovValid CacheBeforeLucid
x
        in $WCacheBeforeLucid :: 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 = $WCacheBeforeLucid :: 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
fovClearLid fovLitLid :: FovLitLid
fovLitLid s :: State
s lid :: LevelId
lid lvl :: 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 s :: State
s lid :: LevelId
lid lvl :: 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)
        | (aid :: ActorId
aid, b :: 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
> 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 discoAspect :: DiscoveryAspect
discoAspect lvl :: 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 (accLight :: Int
accLight, accDouse :: Int
accDouse) (iid :: ItemId
iid, _) =
        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 0 of
          EQ -> (Int
accLight, Int
accDouse)
          GT -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
shine Int
accLight, Int
accDouse)
          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 bag :: EnumMap ItemId ItemQuant
bag acc :: (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)
     | (p :: Point
p, bag :: 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 (maxLight :: Int
maxLight, maxDouse :: Int
maxDouse) = EnumMap ItemId ItemQuant -> (Int, Int) -> (Int, Int)
processBag EnumMap ItemId ItemQuant
bag (0, 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
> 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 clearPs :: FovClear
clearPs allItems :: [(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 s :: 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 fid :: FactionId
fid _ = 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 p :: Point
p t :: ContentId TileKind
t set :: [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 s :: 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 s :: 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
fovClearLid fovLitLid :: FovLitLid
fovLitLid s :: 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
    (\lid :: LevelId
lid lvl :: 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
fovLucidLid fovClearLid :: FovClearLid
fovClearLid fid :: FactionId
fid s :: 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 (\lid :: LevelId
lid _ ->
                            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 lid :: 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 fl :: FovLucid
fl) -> FovLucid
fl
        _ -> String -> FovLucid
forall a. HasCallStack => String -> a
error (String -> FovLucid) -> String -> FovLucid
forall a b. (a -> b) -> a -> b
$ "" String -> (LevelId, FovLucidLid) -> String
forall v. Show v => String -> v -> String
`showFailure` (LevelId
lid, FovLucidLid
fovLucidLid)
      getValid :: FovValid CacheBeforeLucid -> CacheBeforeLucid
getValid (FovValid pc :: CacheBeforeLucid
pc) = CacheBeforeLucid
pc
      getValid FovInvalid = String -> CacheBeforeLucid
forall a. HasCallStack => String -> a
error (String -> CacheBeforeLucid) -> String -> CacheBeforeLucid
forall a b. (a -> b) -> a -> b
$ "" String -> FactionId -> String
forall v. Show v => String -> v -> String
`showFailure` FactionId
fid
      per :: LevelId -> PerceptionCache -> Perception
per lid :: LevelId
lid pc :: 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
fovClearLid fid :: FactionId
fid lid :: LevelId
lid s :: 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 (aid :: ActorId
aid, b :: 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
<= 0
              Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
              Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 $WPerceptionCache :: 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 spectatorPos :: Point
spectatorPos fc :: FovClear
fc = case Int
radius of
  2 -> Point -> EnumSet Point
squareUnsafeSet Point
spectatorPos
  1 -> Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k
ES.singleton Point
spectatorPos
  0 -> EnumSet Point
forall k. EnumSet k
ES.empty  -- e.g., smell for non-smelling
  _ | Int
radius Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 -> EnumSet Point
forall k. EnumSet k
ES.empty
  _ ->
    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
- 1) Int -> Bool
isClear (Matrix -> Bump -> Int
trV Matrix
m)
        trV :: Matrix -> Bump -> PointI
        {-# INLINE trV #-}
        trV :: Matrix -> Bump -> Int
trV (x1 :: Int
x1, y1 :: Int
y1, x2 :: Int
x2, y2 :: Int
y2) B{..} =
          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 (1, 0, 0, -1)   -- quadrant I
         [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Matrix -> [Int]
mapTr (0, 1, 1, 0)    -- II (counter-clockwise)
         [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Matrix -> [Int]
mapTr (-1, 0, 0, 1)   -- III
         [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Matrix -> [Int]
mapTr (0, -1, -1, 0)  -- IV