Files
loop/src/Dodge/Creature/Perception.hs
T

189 lines
6.8 KiB
Haskell

--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception (
perceptionUpdate,
chaseCritPerceptionUpdate,
visionCheck,
) where
import Control.Lens
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Creature.Radius
import Dodge.Creature.Vocalization
import Dodge.Data.World
import Dodge.FloatFunction
import Geometry.Data
import Geometry.Vector
import qualified IntMapHelp as IM
import Linear
import RandomHelp
import Sound.Data
perceptionUpdate ::
-- | List of creature ids that may direct attention and awareness
[Int] ->
World ->
Creature ->
Creature
perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
chaseCritPerceptionUpdate is w =
rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
{- | Update a creatures awareness based upon the creatures' current direction
of attention
-} -- TODO delete?
basicAwarenessUpdate :: Creature -> Creature
basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
Fixated i ->
cr & crPerception . cpAwareness
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is ->
cr
& crPerception . cpAwareness
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness =
(IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
oldAwareness
becomesCognizant =
any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
thejitter = [RandomImpulse $ RandImpulseCircMove 1]
maybeBark = fromMaybe id $ do
guard becomesCognizant
sid <- vocalizationTest cr
return $
crActionPlan . apAction
.~ [ImpulsesList ([Bark sid] : replicate 5 thejitter)]
-- TODO fold in randgen update, requires that this is a world to world function
chaseCritAwarenessUpdate :: World -> Creature -> Creature
chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
Fixated i ->
cr & crPerception . cpAwareness
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is ->
cr
& crPerception . cpAwareness
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness =
(IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
oldAwareness
becomesCognizant =
any isCognizant $
IM.unionWith cogRaised oldAwareness newAwareness
thejitter = [RandomImpulse $ RandImpulseCircMove 3]
maybeBark = fromMaybe id $ do
guard becomesCognizant
guard $ cr ^? crVocalization . vcCoolDown == Just 0
let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
numjits = fst $ randomR (15, 25) (_randGen w)
return $
(crActionPlan . apStrategy .~ WarningCry)
. ( crActionPlan . apAction
.~ [ ImpulsesList
( [Bark soundid] :
replicate numjits thejitter
++ [[ChangeStrategy $ CloseToMelee 0]]
)
, AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
]
)
cogRaised :: Awareness -> Awareness -> Awareness
cogRaised Suspicious{} Cognizant{} = Cognizant 100
cogRaised _ _ = Suspicious 0
isCognizant :: Awareness -> Bool
isCognizant Cognizant{} = True
isCognizant _ = False
combineAwareness :: Awareness -> Awareness -> Awareness
combineAwareness (Suspicious x) (Suspicious y)
| x + y < 5000 = Suspicious $ x + y
| otherwise = Cognizant 1000
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 :: Awareness -> Maybe Awareness
decreaseAwareness (Suspicious 0) = Nothing
decreaseAwareness (Suspicious x) = Just $ Suspicious (x - 50)
decreaseAwareness (Cognizant 0) = Just $ Suspicious 1000
decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 50
{- | Given a fixed group of creatures, direct attention to those of them that
- are in view.
-}
basicAttentionUpdate ::
-- | Creatures that may attract this creature's attention
[Int] ->
World ->
Creature ->
Creature
basicAttentionUpdate cids w cr =
cr & crPerception . cpAttention
.~ AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
newExtraAwareness ::
-- | source creature
Creature ->
World ->
-- | target creature id
Int ->
Maybe Awareness
newExtraAwareness cr w cid
| dist cpos tpos > 600 = Nothing
| not $ canSeeIndirect (_crID cr) cid w = Nothing
| otherwise = Just . Suspicious $ visionCheck cr tpos * awakeLevelPerception cr
where
tpos = w ^?! cWorld . lWorld . creatures . ix cid . crPos . _xy -- _crPos $ _creatures (_cWorld w) IM.! cid
cpos = cr ^. crPos . _xy
visionCheck :: Creature -> Point2 -> Float
visionCheck cr tpos = doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d
where
vi = _cpVision $ _crPerception cr
cpos = cr ^. crPos . _xy
dirvec = unitVectorAtAngle (_crDir cr)
ang = angleVV dirvec (tpos - (cpos - crRad (cr ^. crType) *^ dirvec))
d = dist tpos cpos
awakeLevelPerception :: Creature -> Float
awakeLevelPerception cr = case _cpVigilance $ _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 _playStatus $ _soundStatus s of
JustStartedPlaying -> Just (_soundPos s, _soundVolume s)
_ -> Nothing
rememberSounds :: World -> Creature -> Creature
rememberSounds w cr =
cr & crMemory . soundsToInvestigate
.~ map fst (filter (soundIsClose w cr) (newSounds w))
-- TODO work out correct form for sounds passing through walls
soundIsClose :: World -> Creature -> (Point2, Float) -> Bool
soundIsClose w cr (pos, vol) =
dist cpos pos < 2000
&& vol > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
&& hasLOS cpos pos w
where
cpos = cr ^. crPos . _xy