Refactor ai

This commit is contained in:
2021-05-12 14:24:31 +02:00
parent 86faf9fd01
commit ead87af3c1
25 changed files with 718 additions and 453 deletions
+194 -7
View File
@@ -1,25 +1,212 @@
module Dodge.Creature.ActionRat
( shootTargetWithStrat
, suppressShootTarget
, suppress
, shootAdvance
, shootFirstMiss
, doStrategyActions
, reloadOverride
, shootAdvanceStrat
, watchUpdateStrat
, goToPostStrat
, overrideInternal
)
where
import Dodge.Data
import Dodge.Base
import Dodge.Base.Collide
import Dodge.Creature.ChooseTarget
import Dodge.Creature.Rationality.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Test
import Geometry
import Data.List
import qualified Data.IntMap.Strict as IM
import Control.Lens
shootTargetWithStrat
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> (World -> Creature -> Creature -> [Action] -> [Action])
-- ^ Function for determining shooting strategy given target
-> World
-> Creature
-> Creature
shootTargetWithStrat targFunc strat w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg
{- | Action update for a simple shooting creature -}
shootAtTarget
suppressShootTarget
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> World
-> Creature
-> Creature
shootAtTarget targFunc w cr = case targFunc cr w of
suppressShootTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crAction %~ shootAtTarg w cr crTarg
Just crTarg -> cr & crActionPlan . crAction %~ suppress w cr crTarg
shootAtTarg :: World -> Creature -> Creature -> [Action] -> [Action]
shootAtTarg w cr tcr as
| canSee (_crID cr) (_crID tcr) w = nub (ShootTillEmpty : as)
| otherwise = as
suppress :: World -> Creature -> Creature -> [Action] -> [Action]
suppress w cr tcr as
| canSee (_crID cr) (_crID tcr) w && cr ^. crStance . posture /= Aiming
&& cr ^? crInv . ix (_crInvSel cr) . wpReloadState == Just 0 =
[ DrawWeapon
, WaitThen 50 ShootTillEmpty
, AimAtCloseSlow
{ _targetID = _crID tcr
, _targetSeenAt = _crPos cr
, _aimSpeed = 0.2
, _slowAimSpeed = 0.01
, _slowAimAngle = pi/4
}
]
| otherwise = as
shootFirstMiss :: Int -> World -> Creature -> Strategy
shootFirstMiss tcid w cr = StrategyActions acs (ShootAt tcid)
where
acs =
[ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))
`DoActionThen`
LeadTarget (10,50)
`DoActionThen`
advanceShoot
`DoActionThen`
LeadTarget (50,0)
`DoActionThen`
(advanceShoot `DoActionWhileThen` lostest
$ DoReplicateThen advanceShoot 75
$ DoImpulses [ChangeStrategy WatchAndWait]
)
]
lostest (w,cr') = canSee (_crID cr') tcid w
advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
shootAdvanceStrat :: Int -> World -> Creature -> Strategy
shootAdvanceStrat tcid _ _ = StrategyActions acs (ShootAt tcid)
where
acs =
[ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))
`DoActionThen`
(DoActionWhileThen advanceShoot lostest
. DoReplicateThen advanceShoot 75
$ DoImpulses [ChangeStrategy WatchAndWait]
)
, AimAtCloseSlow
{ _targetID = tcid
, _targetSeenAt = (0,0) -- hack
, _aimSpeed = 0.2
, _slowAimSpeed = 0.01
, _slowAimAngle = pi/8
}
]
lostest (w,cr') = canSee (_crID cr') tcid w
advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
goToPostStrat :: World -> Creature -> Strategy
goToPostStrat w cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
Just (SentinelAt p _) -> StrategyActions
[DoActionThen (WaitThen 150 holsterIfAiming)
$ DoActionThen (PathTo p)
NoAction
-- $ DoImpulses [ChangeStrategy WatchAndWait]
] $ GetTo p
_ -> WatchAndWait
where
sentinelGoal (SentinelAt p dir) = True
sentinelGoal _ = False
holsterIfAiming
| crIsAiming (w,cr) = HolsterWeapon
| otherwise = NoAction
overrideInternal
:: ((World , Creature) -> Bool)
-> (World -> Creature -> Creature)
-> World
-> Creature
-> Creature
overrideInternal test update w cr
| test (w,cr) = update w cr
| otherwise = cr
shootAdvance :: World -> Creature -> Creature -> [Action] -> [Action]
shootAdvance w cr tcr as
| lostest (w,cr) && cr ^. crStance . posture /= Aiming
&& cr ^? crInv . ix (_crInvSel cr) . wpReloadState == Just 0 =
[ DrawWeapon
, DoImpulses [ChangeStrategy $ ShootAt $ _crID tcr]
, WaitThen 50
. DoActionWhileThen advanceShoot lostest
. DoReplicateThen advanceShoot 50
$ DoImpulses [ChangeStrategy WatchAndWait]
, AimAtCloseSlow
{ _targetID = _crID tcr
, _targetSeenAt = _crPos cr
, _aimSpeed = 0.2
, _slowAimSpeed = 0.01
, _slowAimAngle = pi/8
}
]
| cr ^. crStance . posture == Aiming && cr ^? crInv . ix (_crInvSel cr) . wpReloadState /= Just 0
= [ HolsterWeapon ]
| otherwise = as
where
lostest (w,cr') = canSee (_crID cr) (_crID tcr) w
advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
applyNewStrategies
:: World
-> Creature
-> Creature
applyNewStrategies w cr = case cr ^? crActionPlan . crStrategy of
Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs
& crActionPlan . crStrategy .~ strat
otherwise -> cr
doStrategyActions
:: World
-> Creature
-> Creature
doStrategyActions w cr = case cr ^? crActionPlan . crStrategy of
Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs
& crActionPlan . crStrategy .~ strat
otherwise -> cr
updateShoot
:: World
-> Creature
-> Creature
updateShoot w cr = case _crStrategy $ _crActionPlan cr of
WatchAndWait -> undefined
reloadOverride
:: World
-> Creature
-> Creature
reloadOverride _ cr
| cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0
&& cr ^. crStance . posture == Aiming
= cr & crActionPlan . crStrategy .~ StrategyActions reloadActions Reload
| otherwise = cr
where
reloadActions =
[ HolsterWeapon
, WaitThen 1 $ DoActionWhileThen NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait])
]
watchUpdateStrat
:: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
-> World
-> Creature
-> Creature
watchUpdateStrat fs w cr = case cr ^? crActionPlan . crStrategy of
Just WatchAndWait -> cr
& crActionPlan . crStrategy .~ listGuard (fs, (\_ _ -> WatchAndWait)) (w, cr) w cr
_ -> cr
listGuard :: ([(a -> Bool, b)] , b) -> a -> b
listGuard ( (test,y):ps, z ) x
| test x = y
| otherwise = listGuard (ps, z) x
listGuard (_,z) _ = z