Improve chase crit searching

src/Dodge/Creature/Action.hs

@@ -69,7 +69,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
 
 performPathTo :: Creature -> World -> Point2 -> OutAction
 performPathTo cr w p
-    | dist cpos p < 5 = ([], Nothing)
+    | dist cpos p <= _crRad cr = ([], Nothing)
     | isWalkable cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
     | otherwise = case pointTowardsImpulse p cpos w of
         Just q -> ([MvTurnToward q
@@ -87,7 +87,7 @@ performPathTo cr w p
 performTurnToA :: Creature -> Point2 -> OutAction
 performTurnToA cr p
     | angleVV cdirv dirv < 0.1 = ([], Nothing)
-    | otherwise = ([MvTurnToward p,RandomTurn jit] , Just (TurnToA p))
+    | otherwise = ([MvTurnToward p,RandomTurn jit] , Just (TurnToPoint p))
   where
     cpos = _crPos cr
     cdirv = unitVectorAtAngle (_crDir cr)
@@ -130,7 +130,7 @@ performAction cr w ac = case ac of
         in (concat imps, Just . DoActions $ catMaybes newAcs)
     StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
     PathTo p -> performPathTo cr w p
-    TurnToA p -> performTurnToA cr p
+    TurnToPoint p -> performTurnToA cr p
     LeadTarget p -> case cr ^? crIntention . targetCr . _Just of
         Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
         _        -> ([], Nothing)
@@ -144,9 +144,9 @@ performAction cr w ac = case ac of
         (imp, _)          -> (sideImp ++ imp, Nothing)
     DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
     DoReplicatePartial _   0 pac -> performAction cr w pac
-    DoReplicatePartial sac t pac -> case performAction cr w pac of
+    DoReplicatePartial startac t partac -> case performAction cr w partac of
-        (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac)
+        (imps , Just nextac) -> (imps, Just $ DoReplicatePartial startac t nextac)
-        (imps , _)        -> (imps, Just $ DoReplicatePartial sac (t-1) sac)
+        (imps , _)        -> (imps, Just $ DoReplicatePartial startac (t-1) startac)
     NoAction -> ([],Nothing)
 
 {- | Like a blink action, but no ingoing distortion -}

src/Dodge/Creature/ChaseCrit.hs

@@ -47,7 +47,7 @@ chaseCrit = defaultCreature
         , chaseCritMv
         , chaseCritPerceptionUpdate [0]
         , targetYouWhenCognizant
-        , const turnIfDamaged
+        , const searchIfDamaged
         , const (crMeleeCooldown %~ max 0 . subtract 1)
         ]
     , _crName = "chaseCrit"

src/Dodge/Creature/Memory/Data.hs

@@ -6,8 +6,9 @@ import Geometry.Data
 
 import Control.Lens
 
-newtype Memory = Memory
+data Memory = Memory
     { _soundsToInvestigate :: [Point2]
+    , _nodesSearched       :: [Int]
     }
 
 makeLenses ''Memory

src/Dodge/Creature/ReaderUpdate.hs

@@ -7,7 +7,7 @@ module Dodge.Creature.ReaderUpdate
     , watchUpdateStrat
     , reloadOverride
     , overrideInternal
-    , turnIfDamaged
+    , searchIfDamaged
     , goToTarget
     , flockACC
     , chaseCritMv
@@ -19,6 +19,7 @@ import Dodge.Creature.Test
 import Dodge.Creature.Volition
 import Dodge.Base
 import Dodge.Zone
+import Dodge.Path
 import Geometry
 
 import qualified Data.IntMap.Strict as IM
@@ -93,7 +94,9 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
     StrategyActions _ _ -> cr
     WarningCry -> cr
     _ -> case cr ^? crIntention . mvToPoint . _Just of
-        Just p -> cr & crActionPlan . apAction .~ [PathTo p]
+        Just p | dist (_crPos cr) p > _crRad cr -> cr & crActionPlan . apAction .~ [PathTo p]
+            | otherwise -> cr & crActionPlan . apAction .~ [bfsThenReturn 500]
+                & crIntention . mvToPoint .~ Nothing
         _ -> viewTarget w cr
 
 goToTarget :: World -> Creature -> Creature
@@ -102,11 +105,18 @@ goToTarget w cr =
         Just p -> cr & crActionPlan . apAction .~ [PathTo p]
         _ -> viewTarget w cr
 
+lookAroundSelf :: Action
+lookAroundSelf = UseSelf $ \cr -> TurnToPoint (_crPos cr -.- 10 *.* unitVectorAtAngle (_crDir cr))
+
 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 (TurnToA p)
+                    & 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
@@ -119,7 +129,8 @@ replaceNullWith _ xs = xs
     
 doStrategyActions :: Creature -> Creature
 doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
-    Just (StrategyActions strat acs) -> cr & crActionPlan . apAction .~ acs
+    Just (StrategyActions strat acs) -> cr 
+        & crActionPlan . apAction .~ acs
         & crActionPlan . apStrategy .~ strat
     _ -> cr
 
@@ -165,10 +176,24 @@ targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
     Just (Cognizant _)  -> _creatures w IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures w IM.! 0
     _                   -> cr & crIntention . targetCr .~ Nothing
 
-turnIfDamaged :: Creature -> Creature
+searchIfDamaged :: Creature -> Creature
-turnIfDamaged cr
+searchIfDamaged cr
     | _crPastDamage cr > 0 = case _apStrategy (_crActionPlan cr) of
         WatchAndWait -> cr & crPerception . cpVigilance .~ Vigilant
-            & crActionPlan . apStrategy .~ StrategyActions LookAround [TurnToA (_crPos cr -.- unitVectorAtAngle (_crDir cr))]
+            & crActionPlan . apStrategy .~ StrategyActions LookAround 
+                [(TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr)))
+                `DoActionThen` 40 `WaitThen` bfsThenReturn 500
+                ]
         _ -> cr
     | otherwise = cr
+
+bfsThenReturn :: Int -> Action
+bfsThenReturn t = ArbitraryAction theaction
+  where
+    theaction cr w = fromMaybe NoAction $ do
+        n <- walkableNodeNear w (_crPos cr)
+        let as = take 20 $ map PathTo $ bfsNodePoints n w
+        return $ DoReplicate t $
+            foldr DoActionThen NoAction as
+        
+    

src/Dodge/Data.hs

@@ -1142,8 +1142,8 @@ data Action
     | PathTo 
         {_pathToPoint   :: Point2
         }
-    | TurnToA
+    | TurnToPoint
-        {_turnToAPoint :: Point2
+        {_turnToPoint   :: Point2
         }
 --    | PickupItem 
 --        {_pickupItemID :: Int
@@ -1238,9 +1238,9 @@ instance Show Action where
         PathTo 
           {_pathToPoint = p
           } -> "PathTo:"++shortPoint2 p
-        TurnToA
+        TurnToPoint
-          {_turnToAPoint = p
+          {_turnToPoint = p
-          } -> "TurnToA:"++shortPoint2 p
+          } -> "TurnToPoint:"++shortPoint2 p
 ----      | PickupItem 
 ----          {_pickupItemID :: Int
 ----          }

src/Dodge/Default.hs

@@ -82,7 +82,10 @@ defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
 
 defaultCreatureMemory :: Memory
-defaultCreatureMemory = Memory { _soundsToInvestigate = [] }
+defaultCreatureMemory = Memory 
+    { _soundsToInvestigate = [] 
+    , _nodesSearched = []
+    }
 
 defaultInvSize :: Int
 defaultInvSize = 20

src/Dodge/Floor.hs

@@ -41,7 +41,7 @@ initialAnoTree :: Annotation
 initialAnoTree = OnwardList 
         $ intersperse (AnTree corDoor)
     [ IntAnno $ AnTree . startRoom
-    , AnRoom $ roomCCrits 10
+    , AnRoom $ roomCCrits 0
     , AnRoom $ return airlock0
     , AnRoom slowDoorRoom
     , AnRoom $ roomCCrits 10

src/Dodge/Path.hs

@@ -8,6 +8,7 @@ module Dodge.Path
     , pairsToGraph
     , getNodePos
     , walkableNodeNear
+    , bfsNodePoints
     ) where
 import Dodge.Data
 import Dodge.Base.Collide
@@ -53,6 +54,12 @@ walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
 makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
 makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w
 
+bfsNodePoints :: Int -> World -> [Point2]
+bfsNodePoints n w = mapMaybe (lab g) $ bfs n g
+  where
+    g = _pathGraph w
+
+
 pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
 pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< makePathBetweenPs a b w