Create new files

src/Dodge/Creature/Memory.hs

@@ -0,0 +1,2 @@
+module Dodge.Creature.Memory
+    where

src/Dodge/Creature/Memory/Data.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Creature.Memory.Data
+    where
+import Geometry.Data
+
+import Control.Lens
+
+data MemoryState = MemoryState
+    { _soundsToInvestigate :: [Point2]
+    }
+
+makeLenses ''MemoryState

src/Dodge/Creature/Perception.hs

@@ -0,0 +1,105 @@
+{-# 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 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 . _sounds
+  where
+    f s = Just (_soundPos s, _soundVolume s)
+--    f s | _soundStatus s == JustStartedPlaying
+--                    = Just (_soundPos s, _soundVolume s)
+--        | otherwise = Nothing
+
+rememberSounds :: Creature -> Reader World Creature
+rememberSounds cr = do
+    sList <- fmap newSounds ask
+    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) = True -- vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr))

src/Dodge/Creature/Perception/Data.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Creature.Perception.Data
+    ( PerceptionState (..)
+    , AwakeLevel (..)
+    , AttentionDir (..)
+    , AwarenessLevel (..)
+    , Vision (..)
+    , Audition (..)
+    -- lenses
+    , getAttentiveTo
+    , getFixated
+    , crAttentionDir
+    , crAwakeLevel
+    , crAwarenessLevel
+    , crVision
+    , crAudition
+    , viFOV
+    , viDist
+    , auDist
+    )
+    where
+import Control.Lens
+import qualified Data.IntMap as IM
+
+data PerceptionState = PerceptionState
+    { _crAwakeLevel     :: AwakeLevel
+    , _crAttentionDir   :: AttentionDir
+    , _crAwarenessLevel :: IM.IntMap AwarenessLevel
+    , _crVision         :: Vision
+    , _crAudition       :: Audition
+    }
+
+data Vision = Eyes
+    { _viFOV  :: Float -> Float
+    , _viDist :: Float -> Float
+    }
+data Audition = Ears
+    { _auDist :: Float -> Float
+    }
+
+data AwakeLevel
+    = Comatose
+    | Asleep
+    | Lethargic
+    | Vigilant
+    | Overstrung
+  deriving (Eq,Ord,Show)
+
+data AttentionDir
+    = AttentiveTo {_getAttentiveTo :: IM.IntMap AwarenessLevel }
+    | Fixated {_getFixated :: Int }
+
+data AwarenessLevel
+    = Suspicious Float
+    | Cognizant Float
+
+makeLenses ''AttentionDir
+makeLenses ''PerceptionState
+makeLenses ''Vision
+makeLenses ''Audition