{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | Actors perceiving other actors and the dungeon level.
--
-- Visibility works according to KISS. Everything that player sees is real.
-- There are no unmarked hidden tiles and only solid tiles can be marked,
-- so there are no invisible walls and to pass through an illusory wall,
-- you have to use a turn bumping into it first. Only tiles marked with Suspect
-- can turn out to be another tile. (So, if all tiles are marked with
-- Suspect, the player knows nothing for sure, but this should be avoided,
-- because searching becomes too time-consuming.)
-- Each actor sees adjacent tiles, even when blind, so adjacent tiles are
-- known, so the actor can decide accurately whether to pass thorugh
-- or alter, etc.
--
-- Items are always real and visible. Actors are real, but can be invisible.
-- Invisible actors in walls can't be hit, but are hinted at when altering
-- the tile, so the player can flee or block. Invisible actors in open
-- space can be hit.
module Game.LambdaHack.Common.Perception
  ( PerVisible(..)
  , PerSmelled(..)
  , Perception(..)
  , PerLid
  , PerFid
  , totalVisible, totalSmelled
  , emptyPer, nullPer, addPer, diffPer
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import           GHC.Generics (Generic)

import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Point

-- | Visible positions.
newtype PerVisible = PerVisible {PerVisible -> EnumSet Point
pvisible :: ES.EnumSet Point}
  deriving (Int -> PerVisible -> ShowS
[PerVisible] -> ShowS
PerVisible -> String
(Int -> PerVisible -> ShowS)
-> (PerVisible -> String)
-> ([PerVisible] -> ShowS)
-> Show PerVisible
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerVisible] -> ShowS
$cshowList :: [PerVisible] -> ShowS
show :: PerVisible -> String
$cshow :: PerVisible -> String
showsPrec :: Int -> PerVisible -> ShowS
$cshowsPrec :: Int -> PerVisible -> ShowS
Show, PerVisible -> PerVisible -> Bool
(PerVisible -> PerVisible -> Bool)
-> (PerVisible -> PerVisible -> Bool) -> Eq PerVisible
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerVisible -> PerVisible -> Bool
$c/= :: PerVisible -> PerVisible -> Bool
== :: PerVisible -> PerVisible -> Bool
$c== :: PerVisible -> PerVisible -> Bool
Eq, Get PerVisible
[PerVisible] -> Put
PerVisible -> Put
(PerVisible -> Put)
-> Get PerVisible -> ([PerVisible] -> Put) -> Binary PerVisible
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [PerVisible] -> Put
$cputList :: [PerVisible] -> Put
get :: Get PerVisible
$cget :: Get PerVisible
put :: PerVisible -> Put
$cput :: PerVisible -> Put
Binary)

-- | Smelled positions.
newtype PerSmelled = PerSmelled {PerSmelled -> EnumSet Point
psmelled :: ES.EnumSet Point}
  deriving (Int -> PerSmelled -> ShowS
[PerSmelled] -> ShowS
PerSmelled -> String
(Int -> PerSmelled -> ShowS)
-> (PerSmelled -> String)
-> ([PerSmelled] -> ShowS)
-> Show PerSmelled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerSmelled] -> ShowS
$cshowList :: [PerSmelled] -> ShowS
show :: PerSmelled -> String
$cshow :: PerSmelled -> String
showsPrec :: Int -> PerSmelled -> ShowS
$cshowsPrec :: Int -> PerSmelled -> ShowS
Show, PerSmelled -> PerSmelled -> Bool
(PerSmelled -> PerSmelled -> Bool)
-> (PerSmelled -> PerSmelled -> Bool) -> Eq PerSmelled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerSmelled -> PerSmelled -> Bool
$c/= :: PerSmelled -> PerSmelled -> Bool
== :: PerSmelled -> PerSmelled -> Bool
$c== :: PerSmelled -> PerSmelled -> Bool
Eq, Get PerSmelled
[PerSmelled] -> Put
PerSmelled -> Put
(PerSmelled -> Put)
-> Get PerSmelled -> ([PerSmelled] -> Put) -> Binary PerSmelled
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [PerSmelled] -> Put
$cputList :: [PerSmelled] -> Put
get :: Get PerSmelled
$cget :: Get PerSmelled
put :: PerSmelled -> Put
$cput :: PerSmelled -> Put
Binary)

-- | The type representing the perception of a faction on a level.
data Perception = Perception
  { Perception -> PerVisible
psight :: PerVisible
  , Perception -> PerSmelled
psmell :: PerSmelled
  }
  deriving (Int -> Perception -> ShowS
[Perception] -> ShowS
Perception -> String
(Int -> Perception -> ShowS)
-> (Perception -> String)
-> ([Perception] -> ShowS)
-> Show Perception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Perception] -> ShowS
$cshowList :: [Perception] -> ShowS
show :: Perception -> String
$cshow :: Perception -> String
showsPrec :: Int -> Perception -> ShowS
$cshowsPrec :: Int -> Perception -> ShowS
Show, Perception -> Perception -> Bool
(Perception -> Perception -> Bool)
-> (Perception -> Perception -> Bool) -> Eq Perception
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Perception -> Perception -> Bool
$c/= :: Perception -> Perception -> Bool
== :: Perception -> Perception -> Bool
$c== :: Perception -> Perception -> Bool
Eq, (forall x. Perception -> Rep Perception x)
-> (forall x. Rep Perception x -> Perception) -> Generic Perception
forall x. Rep Perception x -> Perception
forall x. Perception -> Rep Perception x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Perception x -> Perception
$cfrom :: forall x. Perception -> Rep Perception x
Generic)

instance Binary Perception

-- | Perception of a single faction, indexed by level identifier.
type PerLid = EM.EnumMap LevelId Perception

-- | Perception indexed by faction identifier.
-- This can't be added to @FactionDict@, because clients can't see it
-- for other factions.
type PerFid = EM.EnumMap FactionId PerLid

-- | The set of tiles visible by at least one hero.
totalVisible :: Perception -> ES.EnumSet Point
totalVisible :: Perception -> EnumSet Point
totalVisible = PerVisible -> EnumSet Point
pvisible (PerVisible -> EnumSet Point)
-> (Perception -> PerVisible) -> Perception -> EnumSet Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perception -> PerVisible
psight

-- | The set of tiles smelt by at least one hero.
totalSmelled :: Perception -> ES.EnumSet Point
totalSmelled :: Perception -> EnumSet Point
totalSmelled = PerSmelled -> EnumSet Point
psmelled (PerSmelled -> EnumSet Point)
-> (Perception -> PerSmelled) -> Perception -> EnumSet Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perception -> PerSmelled
psmell

emptyPer :: Perception
emptyPer :: Perception
emptyPer = Perception :: PerVisible -> PerSmelled -> Perception
Perception { psight :: PerVisible
psight = EnumSet Point -> PerVisible
PerVisible EnumSet Point
forall k. EnumSet k
ES.empty
                      , psmell :: PerSmelled
psmell = EnumSet Point -> PerSmelled
PerSmelled EnumSet Point
forall k. EnumSet k
ES.empty }

nullPer :: Perception -> Bool
nullPer :: Perception -> Bool
nullPer Perception
per = Perception
per Perception -> Perception -> Bool
forall a. Eq a => a -> a -> Bool
== Perception
emptyPer

addPer :: Perception -> Perception -> Perception
addPer :: Perception -> Perception -> Perception
addPer Perception
per1 Perception
per2 =
  Perception :: PerVisible -> PerSmelled -> Perception
Perception
    { psight :: PerVisible
psight = EnumSet Point -> PerVisible
PerVisible
               (EnumSet Point -> PerVisible) -> EnumSet Point -> PerVisible
forall a b. (a -> b) -> a -> b
$ Perception -> EnumSet Point
totalVisible Perception
per1 EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
`ES.union` Perception -> EnumSet Point
totalVisible Perception
per2
    , psmell :: PerSmelled
psmell = EnumSet Point -> PerSmelled
PerSmelled
               (EnumSet Point -> PerSmelled) -> EnumSet Point -> PerSmelled
forall a b. (a -> b) -> a -> b
$ Perception -> EnumSet Point
totalSmelled Perception
per1 EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
`ES.union` Perception -> EnumSet Point
totalSmelled Perception
per2
    }

diffPer :: Perception -> Perception -> Perception
diffPer :: Perception -> Perception -> Perception
diffPer Perception
per1 Perception
per2 =
  Perception :: PerVisible -> PerSmelled -> Perception
Perception
    { psight :: PerVisible
psight = EnumSet Point -> PerVisible
PerVisible
               (EnumSet Point -> PerVisible) -> EnumSet Point -> PerVisible
forall a b. (a -> b) -> a -> b
$ Perception -> EnumSet Point
totalVisible Perception
per1 EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.\\ Perception -> EnumSet Point
totalVisible Perception
per2
    , psmell :: PerSmelled
psmell = EnumSet Point -> PerSmelled
PerSmelled
               (EnumSet Point -> PerSmelled) -> EnumSet Point -> PerSmelled
forall a b. (a -> b) -> a -> b
$ Perception -> EnumSet Point
totalSmelled Perception
per1 EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.\\ Perception -> EnumSet Point
totalSmelled Perception
per2
    }