189 lines
6.8 KiB
Haskell
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
|