Chase crit suspicion increases more when you are closer

src/Dodge/Creature/Perception.hs

@@ -47,9 +47,6 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
         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
         maybeBark
             | becomesCognizant = case vocalizationTest cr of
                 Just sid ->
@@ -81,11 +78,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
         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
-        --  do
-        --    p <- randInCirc 2
-        --    return $ Move p
         maybeBark
             | becomesCognizant -- && randBool
                 && cr ^? crVocalization . vcCoolDown == Just 0 =
@@ -99,7 +92,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
                                   replicate numjits [RandomImpulse thejitter]
                                     ++ [[ChangeStrategy $ CloseToMelee 0]]
                                 )
-                            , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos) --_crPos $ _creatures (_cWorld w) IM.! 0)
+                            , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos)
                             ]
             | otherwise = id
 
@@ -149,20 +142,26 @@ newExtraAwareness ::
 newExtraAwareness cr w cid
     | dist cpos tpos > 600 = Nothing
     | not $ canSeeIndirect (_crID cr) cid w = Nothing
-    | otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
+    | otherwise = Just . Suspicious $ visionCheck cr tpos * awakeLevelPerception cr
+  where
+    tpos = w ^?! cWorld . lWorld . creatures . ix cid . crPos -- _crPos $ _creatures (_cWorld w) IM.! cid
+    cpos = _crPos cr
+
+visionCheck :: Creature -> Point2 -> Float
+visionCheck cr tpos = doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d
   where
     vi = _cpVision $ _crPerception cr
-    tpos = w ^?! cWorld . lWorld . creatures . ix cid . crPos -- _crPos $ _creatures (_cWorld 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
+    Lethargic -> 100
+    Vigilant -> 1000
     Overstrung -> 10000
 
 newSounds :: World -> [(Point2, Float)]
@@ -174,14 +173,8 @@ newSounds = mapMaybe f . M.elems . _playingSounds
 
 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))
+    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

src/Dodge/Creature/ReaderUpdate.hs

@@ -1,4 +1,3 @@
--- | Functions updating a creature in a Reader World environment
 module Dodge.Creature.ReaderUpdate (
     doStrategyActions,
     setTargetMv,
@@ -17,6 +16,7 @@ module Dodge.Creature.ReaderUpdate (
 
 import Control.Applicative
 import Control.Lens
+import Control.Monad
 import Data.Bifunctor
 import Data.Maybe
 import Dodge.Base
@@ -26,7 +26,6 @@ import Dodge.Data.World
 import Dodge.Zoning.Creature
 import FoldableHelp
 import Geometry
-import Control.Monad
 
 overrideMeleeCloseTarget :: Creature -> Creature
 overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
@@ -34,12 +33,13 @@ overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crInten
 tryMeleeAttack :: Creature -> Creature -> Creature
 tryMeleeAttack cr tcr
     | _crMeleeCooldown cr == 0
-        && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5
-        && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi / 4 =
+        && dist tpos cpos < _crRad cr + _crRad tcr + 5
+        && abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4 =
         cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
     | otherwise = cr
   where
     cpos = _crPos cr
+    tpos = _crPos tcr
 
 setMvPos :: World -> Creature -> Creature
 setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
@@ -47,14 +47,9 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
     int = _crIntention cr
     mtpos = do
         tpos <- _crPos <$> _targetCr int
-        if hasLOSIndirect (_crPos cr) tpos w
-            then Just tpos
-            else Nothing
-    mpos =
-        mtpos
-            <|> _mvToPoint int
-
---        <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
+        guard $ hasLOSIndirect (_crPos cr) tpos w
+        return $ tpos
+    mpos = mtpos <|> _mvToPoint int
 
 setViewPos :: Creature -> Creature
 setViewPos cr = cr & crIntention . viewPoint %~ (<|> mpos)
@@ -112,31 +107,25 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
         _ -> viewTarget w cr
 
 goToTarget :: World -> Creature -> Creature
-goToTarget w cr =
-    case cr ^? crIntention . mvToPoint . _Just of
-        Just p -> cr & crActionPlan . apAction .~ [PathTo p]
-        _ -> viewTarget w cr
+goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of
+    Just p -> cr & crActionPlan . apAction .~ [PathTo p]
+    _ -> viewTarget w cr
 
-lookAroundSelf :: Action
-lookAroundSelf = UseSelf CrTurnAround
+--lookAroundSelf :: Action
+--lookAroundSelf = UseSelf CrTurnAround
 
 viewTarget :: World -> Creature -> Creature
-viewTarget w cr = do
-    case cr ^? crIntention . viewPoint . _Just of
-        Just p
-            | hasLOSIndirect p (_crPos cr) w ->
-                cr'
-                    & crActionPlan . apAction
-                        %~ replaceNullWith
-                            ( TurnToPoint p
-                                `DoActionThen` 40 `WaitThen` lookAroundSelf
-                                `DoActionThen` 20 `WaitThen` lookAroundSelf
-                            )
-                    & crIntention . viewPoint .~ Nothing
-            | otherwise -> cr' & crActionPlan . apAction %~ replaceNullWith (PathTo p)
-        Nothing -> cr -- & crPerception . crAwakeLevel .~ Lethargic
-  where
-    cr' = cr & crPerception . cpVigilance .~ Vigilant
+viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
+    Just p
+        | hasLOSIndirect p (_crPos cr) w ->
+            cr
+                & crActionPlan . apAction
+                    %~ replaceNullWith
+                        ( TurnToPoint p
+                        )
+                & crIntention . viewPoint .~ Nothing
+        | otherwise -> cr & crActionPlan . apAction %~ replaceNullWith (PathTo p)
+    Nothing -> cr
 
 replaceNullWith :: a -> [a] -> [a]
 replaceNullWith x [] = [x]
@@ -155,7 +144,7 @@ reloadOverride cr = fromMaybe cr $ do
     guard $ cr ^. crStance . posture == Aiming
     itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
     guard $ cr ^? crInv . ix itRef . itUse . heldConsumption . laLoaded == Just 0
-    return $    cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
+    return $ cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
   where
     reloadActions =
         [ holsterWeapon
@@ -192,20 +181,22 @@ targetYouWhenCognizant :: World -> Creature -> Creature
 targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
     -- so this caused a space leak: be careful with ?~
     -- consider changing targeted creature to be just an index
-    Just (Cognizant _) -> (w ^?! cWorld . lWorld . creatures . ix 0) `seq` cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
+    Just (Cognizant _) -> (w ^?! cWorld . lWorld . creatures . ix 0) `seq` 
+        cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
+            & crPerception . cpVigilance .~ Vigilant
     _ -> cr & crIntention . targetCr .~ Nothing
 
 searchIfDamaged :: Creature -> Creature
 searchIfDamaged cr
-    | _crPastDamage cr > 0 && 
-        _apStrategy (_crActionPlan cr) == WatchAndWait =
-            cr & crPerception . cpVigilance .~ Vigilant
-                & crActionPlan . apStrategy
-                    .~ StrategyActions
-                        LookAround
-                        [ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
-                            `DoActionThen` 40 `WaitThen` bfsThenReturn 500
-                        ]
+    | _crPastDamage cr > 0
+        && _apStrategy (_crActionPlan cr) == WatchAndWait =
+        cr & crPerception . cpVigilance .~ Vigilant
+            & crActionPlan . apStrategy
+                .~ StrategyActions
+                    LookAround
+                    [ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
+                        `DoActionThen` 40 `WaitThen` bfsThenReturn 500
+                    ]
     | otherwise = cr
 
 bfsThenReturn :: Int -> Action

src/Dodge/Data/FloatFunction.hs

@@ -12,6 +12,7 @@ data FloatFloat
     = FloatID
     | FloatFOV Float
     | FloatLessCheck Float
+    | FloatDistLinearMaxMin Float Float Float
     | FloatAbsCheckGreaterLess Float Float Float
     | FloatConst Float
     deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Debug.hs

@@ -1,5 +1,6 @@
 module Dodge.Debug where
 
+import Data.Aeson.Types
 import AesonHelp
 import Control.Lens
 import Data.List (sortOn)
@@ -55,16 +56,27 @@ debugSelectCreatureMessage u = fromMaybe
         cid <- u ^? uvDebug . ix Select_creature . debugInfo . debugMInt . _Just
         i <- u ^? uvDebug . ix Select_creature . debugInfo . debugInt
         cap <- debugSelectCreatureList cid u !! i
-        return $ show cid : getPretty cap
+        return $ show cid : cap
 
 debugSelectCreatureList :: Int -> Universe -> [Maybe [String]]
 debugSelectCreatureList cid u =
-    [ fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan
-    , fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crPerception
-    , fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crIntention
-    , fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crMemory
+    [ debugList "ActionPlan"
+        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan)
+    , debugList "Perception"
+        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crPerception)
+    , debugList "Intention"
+        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crIntention)
+    , debugList "Memory"
+        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crMemory)
+    , debugList "Strategy"
+        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan . apStrategy)
     ]
 
+
+debugList :: (Functor f, ToJSON a) => String -> f a -> f [String]
+debugList str = fmap (([str] ++) . getPrettyShort )
+
+
 clickGetCreature :: Universe -> DebugInfo
 clickGetCreature u
     | SDL.ButtonLeft `M.member` (u ^. uvWorld . input . mouseButtons)

src/Dodge/Default/Creature.hs

@@ -91,8 +91,9 @@ defaultPerceptionState =
 defaultVision :: Vision
 defaultVision =
     Eyes
-        { _viFOV = FloatFOV 0.5
-        , _viDist = FloatLessCheck 500
+        { _viFOV = FloatFOV 0.8
+        --, _viDist = FloatLessCheck 500
+        , _viDist = FloatDistLinearMaxMin 500 10 1
         }
 
 defaultAudition :: Audition

src/Dodge/FloatFunction.hs

@@ -12,6 +12,9 @@ doFloatFloat ff x = case ff of
     FloatLessCheck y
         | x > y -> 0
         | otherwise -> 1
+    FloatDistLinearMaxMin maxd a b
+        | x > maxd -> 0
+        | otherwise -> (a * (maxd - x) + b * (x - maxd)) / maxd
     FloatAbsCheckGreaterLess a y1 y2
         | abs x > a -> y1
         | otherwise -> y2