From 9c352e4a833e2118991143757ae36fa7d59d01d9 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 9 Jul 2022 11:25:10 +0100 Subject: [PATCH] Improve chase crit searching --- src/Dodge/Creature/Action.hs | 12 ++++----- src/Dodge/Creature/ChaseCrit.hs | 2 +- src/Dodge/Creature/Memory/Data.hs | 3 ++- src/Dodge/Creature/ReaderUpdate.hs | 39 ++++++++++++++++++++++++------ src/Dodge/Data.hs | 10 ++++---- src/Dodge/Default.hs | 5 +++- src/Dodge/Floor.hs | 2 +- src/Dodge/Path.hs | 7 ++++++ 8 files changed, 58 insertions(+), 22 deletions(-) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 962b2307e..c738a6ce2 100644 --- a/src/Dodge/Creature/Action.hs +++ b/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 - (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac) - (imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac) + DoReplicatePartial startac t partac -> case performAction cr w partac of + (imps , Just nextac) -> (imps, Just $ DoReplicatePartial startac t nextac) + (imps , _) -> (imps, Just $ DoReplicatePartial startac (t-1) startac) NoAction -> ([],Nothing) {- | Like a blink action, but no ingoing distortion -} diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index b48c7b81d..0ad68509a 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/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" diff --git a/src/Dodge/Creature/Memory/Data.hs b/src/Dodge/Creature/Memory/Data.hs index a639e5090..0a39bce04 100644 --- a/src/Dodge/Creature/Memory/Data.hs +++ b/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 diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 9794b435b..cd179e433 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/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 -turnIfDamaged cr +searchIfDamaged :: Creature -> Creature +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 + + diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 4f382b8d0..7d28282ea 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1142,8 +1142,8 @@ data Action | PathTo {_pathToPoint :: Point2 } - | TurnToA - {_turnToAPoint :: Point2 + | TurnToPoint + {_turnToPoint :: Point2 } -- | PickupItem -- {_pickupItemID :: Int @@ -1238,9 +1238,9 @@ instance Show Action where PathTo {_pathToPoint = p } -> "PathTo:"++shortPoint2 p - TurnToA - {_turnToAPoint = p - } -> "TurnToA:"++shortPoint2 p + TurnToPoint + {_turnToPoint = p + } -> "TurnToPoint:"++shortPoint2 p ---- | PickupItem ---- {_pickupItemID :: Int ---- } diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index eba8b9496..bdec50893 100644 --- a/src/Dodge/Default.hs +++ b/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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 54eeb6b58..7a305cda0 100644 --- a/src/Dodge/Floor.hs +++ b/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 diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index 44545cc01..a853e40c3 100644 --- a/src/Dodge/Path.hs +++ b/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