106 lines
3.8 KiB
Haskell
106 lines
3.8 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Creature.Perception
|
|
( perceptionUpdate
|
|
, newSounds
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Creature.Perception.Data
|
|
import Dodge.Creature.Memory.Data
|
|
import Dodge.Base.Collide
|
|
import Geometry.Vector
|
|
--import Geometry.Data
|
|
import Geometry.Data
|
|
import Sound.Data
|
|
--import StrictHelp
|
|
|
|
import Data.Maybe
|
|
import Control.Lens
|
|
import Control.Monad.Reader
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Map.Strict as M
|
|
|
|
{- | Ties together (currently) an awareness and attention update -}
|
|
perceptionUpdate
|
|
:: [Int] -- ^ List of creature ids that may direct attention and awareness
|
|
-> Creature
|
|
-> Reader World Creature
|
|
perceptionUpdate is cr = basicAttentionUpdate is cr >>= basicAwarenessUpdate
|
|
>>= rememberSounds
|
|
|
|
{- | Update a creatures awareness based upon the creatures' current direction
|
|
of attention -}
|
|
basicAwarenessUpdate
|
|
:: Creature -> Reader World Creature
|
|
basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
|
|
AttentiveTo is -> pure $ cr & crPerception . crAwarenessLevel
|
|
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
|
|
Fixated i -> pure $ cr & crPerception . crAwarenessLevel
|
|
%~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
|
|
|
|
combineAwareness :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel
|
|
combineAwareness (Suspicious x) (Suspicious y)
|
|
| x + y < 10000 = Suspicious $ x + y
|
|
| otherwise = Cognizant 5000
|
|
combineAwareness (Suspicious x) (Cognizant y) = Cognizant $ min 10000 $ x + y
|
|
combineAwareness (Cognizant x) (Suspicious y) = Cognizant $ min 10000 $ x + y
|
|
combineAwareness (Cognizant x) (Cognizant y) = Cognizant $ min 10000 $ x + y
|
|
|
|
{- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
|
|
-}
|
|
decreaseAwareness :: AwarenessLevel -> Maybe AwarenessLevel
|
|
decreaseAwareness (Suspicious 0) = Nothing
|
|
decreaseAwareness (Suspicious x) = Just $ Suspicious (x - 50)
|
|
decreaseAwareness (Cognizant 0) = Just $ Suspicious 10000
|
|
decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 50
|
|
|
|
{- | Given a fixed group of creatures, direct attention to those of them that
|
|
- are in view. -}
|
|
basicAttentionUpdate
|
|
:: [Int] -- ^ Creatures that may attract this creature's attention
|
|
-> Creature
|
|
-> Reader World Creature
|
|
basicAttentionUpdate cids cr = do
|
|
w <- ask
|
|
pure $ cr & crPerception . crAttentionDir .~
|
|
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
|
|
|
|
newExtraAwareness
|
|
:: Creature -- ^ source creature
|
|
-> World
|
|
-> Int -- ^ target creature id
|
|
-> Maybe AwarenessLevel
|
|
newExtraAwareness cr w cid
|
|
| not $ canSeeIndirect (_crID cr) cid w = Nothing
|
|
| otherwise = Just . Suspicious $ _viFOV vi ang * _viDist vi d * awakeLevelPerception cr
|
|
where
|
|
vi = _crVision $ _crPerception cr
|
|
tpos = _crPos $ _creatures w IM.! cid
|
|
cpos = _crPos cr
|
|
ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos)
|
|
d = dist tpos cpos
|
|
|
|
awakeLevelPerception :: Creature -> Float
|
|
awakeLevelPerception cr = case _crAwakeLevel $ _crPerception cr of
|
|
Comatose -> 0
|
|
Asleep -> 10
|
|
Lethargic -> 100
|
|
Vigilant -> 1000
|
|
Overstrung -> 10000
|
|
|
|
newSounds :: World -> [(Point2,Float)]
|
|
newSounds = mapMaybe f . M.elems . _playingSounds
|
|
where
|
|
f s = case _soundStatus s of
|
|
JustStartedPlaying -> Just (_soundPos s, _soundVolume s)
|
|
_ -> Nothing
|
|
|
|
rememberSounds :: Creature -> Reader World Creature
|
|
rememberSounds cr = do
|
|
sList <- asks newSounds
|
|
return $ cr & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) sList)
|
|
-- return $ cr & crMemory . soundsToInvestigate .~ [V2 0 0]
|
|
|
|
soundIsClose :: Creature -> (Point2,Float) -> Bool
|
|
soundIsClose cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr))
|