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

Chase crit suspicion increases more when you are closer

Browse Source
This commit is contained in:
justin
2023-04-30 18:12:54 +01:00
parent 08e71e5451
commit 5180e9a995
6 changed files with 73 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Perception.hs
+13 -20
View File
@@ -47,9 +47,6 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
thejitter = RandImpulseCircMove 1 thejitter = RandImpulseCircMove 1
--do
--p <- randInCirc 1
--return $ Move p
maybeBark maybeBark
| becomesCognizant = case vocalizationTest cr of | becomesCognizant = case vocalizationTest cr of
Just sid -> Just sid ->
@@ -81,11 +78,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
oldAwareness = _cpAwareness $ _crPerception cr oldAwareness = _cpAwareness $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
--randBool = takeOne [False,True] & evalState $ _randGen w
thejitter = RandImpulseCircMove 2 thejitter = RandImpulseCircMove 2
-- do
-- p <- randInCirc 2
-- return $ Move p
maybeBark maybeBark
| becomesCognizant -- && randBool | becomesCognizant -- && randBool
&& cr ^? crVocalization . vcCoolDown == Just 0 = && cr ^? crVocalization . vcCoolDown == Just 0 =
@@ -99,7 +92,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
replicate numjits [RandomImpulse thejitter] replicate numjits [RandomImpulse thejitter]
++ [[ChangeStrategy $ CloseToMelee 0]] ++ [[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 | otherwise = id
@@ -149,20 +142,26 @@ newExtraAwareness ::
newExtraAwareness cr w cid newExtraAwareness cr w cid
| dist cpos tpos > 600 = Nothing | dist cpos tpos > 600 = Nothing
| not $ canSeeIndirect (_crID cr) cid w = 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 where
vi = _cpVision $ _crPerception cr vi = _cpVision $ _crPerception cr
tpos = w ^?! cWorld . lWorld . creatures . ix cid . crPos -- _crPos $ _creatures (_cWorld w) IM.! cid
cpos = _crPos cr cpos = _crPos cr
ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos) ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos)
d = dist tpos cpos d = dist tpos cpos
awakeLevelPerception :: Creature -> Float awakeLevelPerception :: Creature -> Float
awakeLevelPerception cr = case _cpVigilance $ _crPerception cr of awakeLevelPerception cr = case _cpVigilance $ _crPerception cr of
Comatose -> 0 Comatose -> 0
Asleep -> 10 Asleep -> 10
Lethargic -> 200 Lethargic -> 100
Vigilant -> 500 Vigilant -> 1000
Overstrung -> 10000 Overstrung -> 10000
newSounds :: World -> [(Point2, Float)] newSounds :: World -> [(Point2, Float)]
@@ -174,14 +173,8 @@ newSounds = mapMaybe f . M.elems . _playingSounds
rememberSounds :: World -> Creature -> Creature rememberSounds :: World -> Creature -> Creature
rememberSounds w cr = rememberSounds w cr =
cr cr & crMemory . soundsToInvestigate
& crMemory . soundsToInvestigate .~ closesounds .~ map fst (filter (soundIsClose w cr) (newSounds w))
& awakeupdate
where
awakeupdate
| null closesounds = id
| otherwise = crPerception . cpVigilance .~ Vigilant
closesounds = map fst (filter (soundIsClose w cr) (newSounds w))
-- TODO work out correct form for sounds passing through walls -- TODO work out correct form for sounds passing through walls
soundIsClose :: World -> Creature -> (Point2, Float) -> Bool soundIsClose :: World -> Creature -> (Point2, Float) -> Bool
src/Dodge/Creature/ReaderUpdate.hs
+36 -45
View File
@@ -1,4 +1,3 @@
-- | Functions updating a creature in a Reader World environment
module Dodge.Creature.ReaderUpdate ( module Dodge.Creature.ReaderUpdate (
doStrategyActions, doStrategyActions,
setTargetMv, setTargetMv,
@@ -17,6 +16,7 @@ module Dodge.Creature.ReaderUpdate (
import Control.Applicative import Control.Applicative
import Control.Lens import Control.Lens
import Control.Monad
import Data.Bifunctor import Data.Bifunctor
import Data.Maybe import Data.Maybe
import Dodge.Base import Dodge.Base
@@ -26,7 +26,6 @@ import Dodge.Data.World
import Dodge.Zoning.Creature import Dodge.Zoning.Creature
import FoldableHelp import FoldableHelp
import Geometry import Geometry
import Control.Monad
overrideMeleeCloseTarget :: Creature -> Creature overrideMeleeCloseTarget :: Creature -> Creature
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr) 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 :: Creature -> Creature -> Creature
tryMeleeAttack cr tcr tryMeleeAttack cr tcr
| _crMeleeCooldown cr == 0 | _crMeleeCooldown cr == 0
&& dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 && dist tpos cpos < _crRad cr + _crRad tcr + 5
&& abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi / 4 = && abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4 =
cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr] cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
| otherwise = cr | otherwise = cr
where where
cpos = _crPos cr cpos = _crPos cr
tpos = _crPos tcr
setMvPos :: World -> Creature -> Creature setMvPos :: World -> Creature -> Creature
setMvPos w cr = cr & crIntention . mvToPoint .~ mpos setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
@@ -47,14 +47,9 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
int = _crIntention cr int = _crIntention cr
mtpos = do mtpos = do
tpos <- _crPos <$> _targetCr int tpos <- _crPos <$> _targetCr int
if hasLOSIndirect (_crPos cr) tpos w guard $ hasLOSIndirect (_crPos cr) tpos w
then Just tpos return $ tpos
else Nothing mpos = mtpos <|> _mvToPoint int
mpos =
mtpos
<|> _mvToPoint int
-- <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
setViewPos :: Creature -> Creature setViewPos :: Creature -> Creature
setViewPos cr = cr & crIntention . viewPoint %~ (<|> mpos) setViewPos cr = cr & crIntention . viewPoint %~ (<|> mpos)
@@ -112,31 +107,25 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
_ -> viewTarget w cr _ -> viewTarget w cr
goToTarget :: World -> Creature -> Creature goToTarget :: World -> Creature -> Creature
goToTarget w cr = goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of
case cr ^? crIntention . mvToPoint . _Just of Just p -> cr & crActionPlan . apAction .~ [PathTo p]
Just p -> cr & crActionPlan . apAction .~ [PathTo p] _ -> viewTarget w cr
_ -> viewTarget w cr
lookAroundSelf :: Action --lookAroundSelf :: Action
lookAroundSelf = UseSelf CrTurnAround --lookAroundSelf = UseSelf CrTurnAround
viewTarget :: World -> Creature -> Creature viewTarget :: World -> Creature -> Creature
viewTarget w cr = do viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
case cr ^? crIntention . viewPoint . _Just of Just p
Just p | hasLOSIndirect p (_crPos cr) w ->
| hasLOSIndirect p (_crPos cr) w -> cr
cr' & crActionPlan . apAction
& crActionPlan . apAction %~ replaceNullWith
%~ replaceNullWith ( TurnToPoint p
( TurnToPoint p )
`DoActionThen` 40 `WaitThen` lookAroundSelf & crIntention . viewPoint .~ Nothing
`DoActionThen` 20 `WaitThen` lookAroundSelf | otherwise -> cr & crActionPlan . apAction %~ replaceNullWith (PathTo p)
) Nothing -> cr
& crIntention . viewPoint .~ Nothing
| otherwise -> cr' & crActionPlan . apAction %~ replaceNullWith (PathTo p)
Nothing -> cr -- & crPerception . crAwakeLevel .~ Lethargic
where
cr' = cr & crPerception . cpVigilance .~ Vigilant
replaceNullWith :: a -> [a] -> [a] replaceNullWith :: a -> [a] -> [a]
replaceNullWith x [] = [x] replaceNullWith x [] = [x]
@@ -155,7 +144,7 @@ reloadOverride cr = fromMaybe cr $ do
guard $ cr ^. crStance . posture == Aiming guard $ cr ^. crStance . posture == Aiming
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
guard $ cr ^? crInv . ix itRef . itUse . heldConsumption . laLoaded == Just 0 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 where
reloadActions = reloadActions =
[ holsterWeapon [ holsterWeapon
@@ -192,20 +181,22 @@ targetYouWhenCognizant :: World -> Creature -> Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
-- so this caused a space leak: be careful with ?~ -- so this caused a space leak: be careful with ?~
-- consider changing targeted creature to be just an index -- 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 _ -> cr & crIntention . targetCr .~ Nothing
searchIfDamaged :: Creature -> Creature searchIfDamaged :: Creature -> Creature
searchIfDamaged cr searchIfDamaged cr
| _crPastDamage cr > 0 && | _crPastDamage cr > 0
_apStrategy (_crActionPlan cr) == WatchAndWait = && _apStrategy (_crActionPlan cr) == WatchAndWait =
cr & crPerception . cpVigilance .~ Vigilant cr & crPerception . cpVigilance .~ Vigilant
& crActionPlan . apStrategy & crActionPlan . apStrategy
.~ StrategyActions .~ StrategyActions
LookAround LookAround
[ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr)) [ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
`DoActionThen` 40 `WaitThen` bfsThenReturn 500 `DoActionThen` 40 `WaitThen` bfsThenReturn 500
] ]
| otherwise = cr | otherwise = cr
bfsThenReturn :: Int -> Action bfsThenReturn :: Int -> Action
src/Dodge/Data/FloatFunction.hs
+1
View File
@@ -12,6 +12,7 @@ data FloatFloat
= FloatID = FloatID
| FloatFOV Float | FloatFOV Float
| FloatLessCheck Float | FloatLessCheck Float
| FloatDistLinearMaxMin Float Float Float
| FloatAbsCheckGreaterLess Float Float Float | FloatAbsCheckGreaterLess Float Float Float
| FloatConst Float | FloatConst Float
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/Debug.hs
+17 -5
View File
@@ -1,5 +1,6 @@
module Dodge.Debug where module Dodge.Debug where
import Data.Aeson.Types
import AesonHelp import AesonHelp
import Control.Lens import Control.Lens
import Data.List (sortOn) import Data.List (sortOn)
@@ -55,16 +56,27 @@ debugSelectCreatureMessage u = fromMaybe
cid <- u ^? uvDebug . ix Select_creature . debugInfo . debugMInt . _Just cid <- u ^? uvDebug . ix Select_creature . debugInfo . debugMInt . _Just
i <- u ^? uvDebug . ix Select_creature . debugInfo . debugInt i <- u ^? uvDebug . ix Select_creature . debugInfo . debugInt
cap <- debugSelectCreatureList cid u !! i cap <- debugSelectCreatureList cid u !! i
return $ show cid : getPretty cap return $ show cid : cap
debugSelectCreatureList :: Int -> Universe -> [Maybe [String]] debugSelectCreatureList :: Int -> Universe -> [Maybe [String]]
debugSelectCreatureList cid u = debugSelectCreatureList cid u =
[ fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan [ debugList "ActionPlan"
, fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crPerception (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan)
, fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crIntention , debugList "Perception"
, fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crMemory (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 :: Universe -> DebugInfo
clickGetCreature u clickGetCreature u
| SDL.ButtonLeft `M.member` (u ^. uvWorld . input . mouseButtons) | SDL.ButtonLeft `M.member` (u ^. uvWorld . input . mouseButtons)
src/Dodge/Default/Creature.hs
+3 -2
View File
@@ -91,8 +91,9 @@ defaultPerceptionState =
defaultVision :: Vision defaultVision :: Vision
defaultVision = defaultVision =
Eyes Eyes
{ _viFOV = FloatFOV 0.5 { _viFOV = FloatFOV 0.8
, _viDist = FloatLessCheck 500 --, _viDist = FloatLessCheck 500
, _viDist = FloatDistLinearMaxMin 500 10 1
} }
defaultAudition :: Audition defaultAudition :: Audition
src/Dodge/FloatFunction.hs
+3
View File
@@ -12,6 +12,9 @@ doFloatFloat ff x = case ff of
FloatLessCheck y FloatLessCheck y
| x > y -> 0 | x > y -> 0
| otherwise -> 1 | otherwise -> 1
FloatDistLinearMaxMin maxd a b
| x > maxd -> 0
| otherwise -> (a * (maxd - x) + b * (x - maxd)) / maxd
FloatAbsCheckGreaterLess a y1 y2 FloatAbsCheckGreaterLess a y1 y2
| abs x > a -> y1 | abs x > a -> y1
| otherwise -> y2 | otherwise -> y2