loop/src/Dodge/Creature/Perception.hs

--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception
    ( perceptionUpdate
    , chaseCritPerceptionUpdate
--    , newSounds
    ) where
import Dodge.Data
import Dodge.Creature.Vocalization
import Dodge.Base.Collide
import RandomHelp
--import Dodge.SoundLogic
import Geometry.Vector
--import Geometry.Data
import Geometry.Data
import Sound.Data
--import StrictHelp

import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M

perceptionUpdate
    :: [Int]    -- ^ List of creature ids that may direct attention and awareness
    -> 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 = do
            p <- randInCirc 1
            return $ Move p
        maybeBark
            | becomesCognizant = case vocalizationTest cr of
                Just sid -> crActionPlan . crAction .~ 
                    [ImpulsesList
                        [[Bark sid]
                        ,[RandomImpulse thejitter]
                        ,[RandomImpulse thejitter]
                        ,[RandomImpulse thejitter]
                        ,[RandomImpulse thejitter]
                        ,[RandomImpulse thejitter]
                        ]
                    ]
                Nothing -> id
            | otherwise = id

-- 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
        --randBool = takeOne [False,True] & evalState $ _randGen w
        thejitter = do
            p <- randInCirc 2
            return $ Move p
        maybeBark
            | becomesCognizant -- && randBool 
                && cr ^? crVocalization . vcCoolDown == Just 0 
                = let soundid = evalState (takeOne (_vcWarnings (_crVocalization cr))) (_randGen w)
                      numjits = fst $ randomR (15,25) (_randGen w)
                  in crActionPlan . crStrategy .~ StrategyActions WarningCry 
                        [ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++
                            [[ChangeStrategy $ CloseToMelee 0] ])
                        , AimAt 0 (_crPos $ _creatures w IM.! 0)
                        ]
            | otherwise = id

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
    :: [Int] -- ^ Creatures that may attract this creature's attention
    -> World
    -> Creature
    -> Creature
basicAttentionUpdate cids w cr = cr & crPerception . cpAttention .~
    AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)

newExtraAwareness 
    :: Creature -- ^ source creature
    -> World 
    -> Int      -- ^ target creature id
    -> Maybe Awareness
newExtraAwareness cr w cid
    | not $ canSeeIndirect (_crID cr) cid w = Nothing
    | otherwise = Just . Suspicious $ _viFOV vi ang * _viDist vi d * awakeLevelPerception cr
  where
    vi = _cpVision $ _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 _cpVigilance $ _crPerception cr of
    Comatose    -> 0
    Asleep      -> 10
    Lethargic   -> 200
    Vigilant    -> 500
    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 .~ closesounds
    & awakeupdate
  where
    awakeupdate | null closesounds = id
        | otherwise = crPerception . cpVigilance .~ Vigilant
    closesounds = 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 > (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
    && hasLOS cpos pos w
  where
    cpos = _crPos cr