Refactor, try to limit dependencies

2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
@@ -1,98 +1,106 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Creature.Perception
-    ( perceptionUpdate
-    , chaseCritPerceptionUpdate
--    , newSounds
-    ) where
-import Dodge.Data
-import Dodge.FloatFunction
-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
+module Dodge.Creature.Perception (
+    perceptionUpdate,
+    chaseCritPerceptionUpdate,
+) where

-import Data.Maybe
 import Control.Lens
-import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
+import Data.Maybe
+import Dodge.Base.Collide
+import Dodge.Creature.Vocalization
+import Dodge.Data.World
+import Dodge.FloatFunction
+import Geometry.Data
+import Geometry.Vector
+import qualified IntMapHelp as IM
+import RandomHelp
+import Sound.Data

-perceptionUpdate
-    :: [Int]    -- ^ List of creature ids that may direct attention and awareness
-    -> World
-    -> Creature
-    -> Creature
+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 = 
+chaseCritPerceptionUpdate is w =
    rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w

 {- | Update a creatures awareness based upon the creatures' current direction
- of attention -} -- TODO delete?
+ 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
+    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 = RandImpulseCircMove 1 
-            --do
-            --p <- randInCirc 1
-            --return $ Move p
+        thejitter = RandImpulseCircMove 1
+        --do
+        --p <- randInCirc 1
+        --return $ Move p
        maybeBark
            | becomesCognizant = case vocalizationTest cr of
-                Just sid -> crActionPlan . apAction .~ 
-                    [ImpulsesList
-                        [[Bark sid]
-                        ,[RandomImpulse thejitter]
-                        ,[RandomImpulse thejitter]
-                        ,[RandomImpulse thejitter]
-                        ,[RandomImpulse thejitter]
-                        ,[RandomImpulse thejitter]
-                        ]
-                    ]
+                Just sid ->
+                    crActionPlan . apAction
+                        .~ [ 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
+    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 = RandImpulseCircMove 2 
+        thejitter = RandImpulseCircMove 2
        --  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 . apStrategy .~ StrategyActions WarningCry 
-                        [ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++
-                            [[ChangeStrategy $ CloseToMelee 0] ])
-                        , AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0)
-                        ]
+            | 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 . apStrategy
+                        .~ StrategyActions
+                            WarningCry
+                            [ ImpulsesList
+                                ( [Bark soundid] :
+                                  replicate numjits [RandomImpulse thejitter]
+                                    ++ [[ChangeStrategy $ CloseToMelee 0]]
+                                )
+                            , AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0)
+                            ]
            | otherwise = id

 cogRaised :: Awareness -> Awareness -> Awareness
@@ -100,19 +108,18 @@ cogRaised Suspicious{} Cognizant{} = Cognizant 100
 cogRaised _ _ = Suspicious 0

 isCognizant :: Awareness -> Bool
-isCognizant Cognizant {} = True
+isCognizant Cognizant{} = True
 isCognizant _ = False

 combineAwareness :: Awareness -> Awareness -> Awareness
-combineAwareness (Suspicious x) (Suspicious y) 
+combineAwareness (Suspicious x) (Suspicious y)
    | x + y < 5000 = Suspicious $ x + y
-    | otherwise   = Cognizant 1000
+    | 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
+combineAwareness (Cognizant x) (Cognizant y) = Cognizant $ min 10000 $ x + y

-{- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
- -}
+-- | 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)
@@ -120,20 +127,25 @@ 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)
+ - 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 
-    :: Creature -- ^ source creature
-    -> World 
-    -> Int      -- ^ target creature id
-    -> Maybe Awareness
+newExtraAwareness ::
+    -- | source creature
+    Creature ->
+    World ->
+    -- | target creature id
+    Int ->
+    Maybe Awareness
 newExtraAwareness cr w cid
    | not $ canSeeIndirect (_crID cr) cid w = Nothing
    | otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
@@ -141,18 +153,18 @@ newExtraAwareness cr w cid
    vi = _cpVision $ _crPerception cr
    tpos = _crPos $ _creatures (_cWorld w) IM.! cid
    cpos = _crPos cr
-    ang  = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos)
+    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
+    Comatose -> 0
+    Asleep -> 10
+    Lethargic -> 200
+    Vigilant -> 500
+    Overstrung -> 10000

-newSounds :: World -> [(Point2,Float)]
+newSounds :: World -> [(Point2, Float)]
 newSounds = mapMaybe f . M.elems . _playingSounds
  where
    f s = case _playStatus $ _soundStatus s of
@@ -160,18 +172,21 @@ newSounds = mapMaybe f . M.elems . _playingSounds
        _ -> Nothing

 rememberSounds :: World -> Creature -> Creature
-rememberSounds w cr = cr 
-    & crMemory . soundsToInvestigate .~ closesounds
-    & awakeupdate
+rememberSounds w cr =
+    cr
+        & crMemory . soundsToInvestigate .~ closesounds
+        & awakeupdate
  where
-    awakeupdate | null closesounds = id
+    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 > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
-    && hasLOS cpos pos w
+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 = _crPos cr