From 5180e9a995651c79506312ca957393359e99a5e0 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 30 Apr 2023 18:12:54 +0100 Subject: [PATCH] Chase crit suspicion increases more when you are closer --- src/Dodge/Creature/Perception.hs | 33 +++++------- src/Dodge/Creature/ReaderUpdate.hs | 81 +++++++++++++----------------- src/Dodge/Data/FloatFunction.hs | 1 + src/Dodge/Debug.hs | 22 ++++++-- src/Dodge/Default/Creature.hs | 5 +- src/Dodge/FloatFunction.hs | 3 ++ 6 files changed, 73 insertions(+), 72 deletions(-) diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 95acbe9a3..621380b96 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/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 diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 956a17ad6..1b4e1d474 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/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 diff --git a/src/Dodge/Data/FloatFunction.hs b/src/Dodge/Data/FloatFunction.hs index 00bde3887..cbed9413f 100644 --- a/src/Dodge/Data/FloatFunction.hs +++ b/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) diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 411d2066e..3c903dcff 100644 --- a/src/Dodge/Debug.hs +++ b/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) diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index 438f4cd1d..fc7e4874f 100644 --- a/src/Dodge/Default/Creature.hs +++ b/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 diff --git a/src/Dodge/FloatFunction.hs b/src/Dodge/FloatFunction.hs index 21c9cc256..8a221044f 100644 --- a/src/Dodge/FloatFunction.hs +++ b/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