--{-# LANGUAGE TupleSections #-} module Dodge.Creature.Perception ( perceptionUpdate, visionCheck, ) where import Dodge.SoundLogic.ExternallyGeneratedSounds import Dodge.Creature.Vocalization 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.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 w . basicAttentionUpdate is w {- | Update a creatures awareness based upon the creatures' current direction of attention -} -- TODO delete? basicAwarenessUpdate :: World -> Creature -> Creature basicAwarenessUpdate 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) & maybeBecomeCognizant where oldAwareness = _cpAwareness $ _crPerception cr newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness maybeBecomeCognizant = fromMaybe id $ do guard becomesCognizant -- guard $ cr ^. crVocalization == VocReady return $ (crActionPlan . apStrategy .~ WarningCry) . (crActionPlan . apAction .~ [ImpulsesList (crImpulsesOnCognizant w cr) , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy) ]) crImpulsesOnCognizant :: World -> Creature -> [[Impulse]] crImpulsesOnCognizant w cr = case cr ^. crType of ChaseCrit {} | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 3] ++ [[ChangeStrategy $ CloseToMelee 0]] HoverCrit {} | Just sid <- cognizantVoc w cr -> [[Bark sid]] ++ [[ChangeStrategy $ CloseToMelee 0]] _ | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 1] _ -> replicate 5 [RandomImpulse $ RandImpulseCircMove 3] cognizantVoc :: World -> Creature -> Maybe SoundID cognizantVoc w cr = case cr ^. crType of ChaseCrit {} -> Just (evalState (takeOne (crWarningSounds cr)) (_randGen w)) HoverCrit {} -> Just beep3QuickS _ -> Nothing -- 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 == VocReady -- 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