justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Improve chase crit searching

Browse Source
This commit is contained in:
justin
2022-07-09 11:25:10 +01:00
parent f57bcebb7a
commit 9c352e4a83
8 changed files with 58 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+6 -6
View File
@@ -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 -}
src/Dodge/Creature/ChaseCrit.hs
+1 -1
View File
@@ -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
+2 -1
View File
@@ -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
+32 -7
View File
@@ -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
src/Dodge/Data.hs
+5 -5
View File
@@ -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
---- }
src/Dodge/Default.hs
+4 -1
View File
@@ -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
+1 -1
View File
@@ -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
+7
View File
@@ -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