Start ai cleanup
This commit is contained in:
@@ -1,12 +1,27 @@
|
||||
{- | Function updating a creature in a Reader World environment -}
|
||||
{- | Functions updating a creature in a Reader World environment -}
|
||||
module Dodge.Creature.ReaderUpdate
|
||||
( doStrategyActionsR
|
||||
, chaseTargetR
|
||||
, chaseTargetRR
|
||||
, setTargetMv
|
||||
, targetYouWhenCognizantR
|
||||
, overrideMeleeCloseTargetR
|
||||
, watchUpdateStratR
|
||||
, reloadOverrideR
|
||||
, overrideInternalRRR
|
||||
, goToTarget
|
||||
, flockACCR
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Creature.Stance.Data
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Creature.Volition
|
||||
import Dodge.Creature.AlertLevel.Data
|
||||
import Dodge.Base
|
||||
import Dodge.Base.Collide
|
||||
import Geometry
|
||||
import FoldableHelp
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Monad.Reader
|
||||
@@ -27,32 +42,90 @@ tryMeleeAttack cr tcr
|
||||
| otherwise = cr
|
||||
where
|
||||
cpos = _crPos cr
|
||||
--meleeActions =
|
||||
-- [DoImpulses [Melee (_crID tcr)]
|
||||
-- `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
|
||||
-- ]
|
||||
|
||||
chaseTargetRR
|
||||
:: (Creature -> Reader World (Maybe Creature)) -- ^ Function for determining target
|
||||
-> Creature
|
||||
-> Reader World Creature
|
||||
chaseTargetRR targFunc cr = do
|
||||
targ <- targFunc cr
|
||||
case targ of
|
||||
Nothing -> pure cr
|
||||
Just crTarg -> pure $ cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg
|
||||
setTargetMv
|
||||
:: (Creature -> Reader World (Maybe Creature)) -- ^ Function for determining target
|
||||
-> Creature
|
||||
-> Reader World Creature
|
||||
setTargetMv targFunc cr = do
|
||||
targ <- targFunc cr
|
||||
case targ of
|
||||
Nothing -> pure cr
|
||||
Just crTarg -> pure $ cr & crMvTarget .~ Just (_crPos crTarg)
|
||||
flockACCR :: Creature -> Reader World Creature
|
||||
flockACCR cr = do
|
||||
case cr ^? crTarget . _Just of
|
||||
Nothing -> pure cr
|
||||
Just tcr -> do
|
||||
w <- ask
|
||||
let tpos = _crPos tcr
|
||||
cpos = _crPos cr
|
||||
isFarACC cr' = _crGroup cr' == _crGroup cr
|
||||
&& _crID cr' /= _crID cr
|
||||
&& dist (_crPos cr') tpos > dist cpos tpos
|
||||
nearACCs = IM.filter isFarACC $ creaturesNearPointI 5 cpos w
|
||||
macr = safeMinimumOn (dist cpos . _crPos) nearACCs
|
||||
case macr of
|
||||
Nothing -> pure cr
|
||||
Just acr -> do
|
||||
let r = _crRad acr + _crRad cr + 10
|
||||
horDir = normalizeV (vNormal (cpos -.- tpos))
|
||||
horShift = if isLHS tpos cpos (_crPos acr)
|
||||
then r *.* horDir
|
||||
else negate r *.* horDir
|
||||
pure $ cr & crMvTarget .~ Just (tpos +.+ horShift)
|
||||
|
||||
goToTarget :: Creature -> Reader World Creature
|
||||
goToTarget cr = do
|
||||
w <- ask
|
||||
case cr ^? crMvTarget . _Just of
|
||||
Just p
|
||||
| dist p cpos > _crRad cr + 10 && hasLOS p cpos w
|
||||
-> pure $ cr & crActionPlan . crImpulse .~
|
||||
[ MoveForward speed
|
||||
, TurnToward p (trad dirOffset)
|
||||
, RandomTurn jit
|
||||
]
|
||||
| dist p cpos > _crRad cr + 10
|
||||
-> pure $ cr & crActionPlan . crAction .~ [PathTo p]
|
||||
where
|
||||
dirOffset = abs (_crDir cr - argV (p -.- cpos))
|
||||
_ -> pure cr
|
||||
where
|
||||
cpos = _crPos cr
|
||||
mvType = _crMvType cr
|
||||
speed = _mvSpeed mvType
|
||||
trad = _mvTurnRad mvType
|
||||
jit = _mvTurnJit mvType
|
||||
|
||||
|
||||
chaseTargetR
|
||||
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
|
||||
-> Creature
|
||||
-> Reader World Creature
|
||||
chaseTargetR targFunc cr = reader $ \w -> case targFunc cr w of
|
||||
chaseTargetR targFunc cr = reader $ \w -> case targFunc cr w of
|
||||
Nothing -> cr
|
||||
Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg
|
||||
|
||||
chaseTarg :: Creature -> Creature -> [Impulse]
|
||||
chaseTarg cr crT = [MoveForward speed, TurnToward tpos (trad dirOffset), RandomTurn jit]
|
||||
where
|
||||
cpos = _crPos cr
|
||||
tpos = _crPos crT
|
||||
mvType = _crMvType cr
|
||||
speed = _chaseSpeed mvType
|
||||
trad = _chaseTurnRad mvType
|
||||
jit = _chaseTurnJit mvType
|
||||
cpos = _crPos cr
|
||||
tpos = _crPos crT
|
||||
mvType = _crMvType cr
|
||||
speed = _mvSpeed mvType
|
||||
trad = _mvTurnRad mvType
|
||||
jit = _mvTurnJit mvType
|
||||
dirOffset = abs (_crDir cr - argV (tpos -.- cpos))
|
||||
-- | abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
|
||||
-- = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
|
||||
-- | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
|
||||
|
||||
doStrategyActionsR
|
||||
:: Creature
|
||||
@@ -76,24 +149,14 @@ reloadOverrideR cr
|
||||
, WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait])
|
||||
]
|
||||
|
||||
overrideInternalR
|
||||
:: ((World , Creature) -> Bool)
|
||||
-> (World -> Creature -> Creature)
|
||||
-> Creature
|
||||
-> Reader World Creature
|
||||
overrideInternalR test update cr = reader $ \w ->
|
||||
if test (w,cr)
|
||||
then update w cr
|
||||
else cr
|
||||
overrideInternalRR
|
||||
:: ((World , Creature) -> Bool)
|
||||
overrideInternalRRR
|
||||
:: (Creature -> Reader World Bool)
|
||||
-> (Creature -> Reader World Creature)
|
||||
-> Creature
|
||||
-> Reader World Creature
|
||||
overrideInternalRR test update cr = reader $ \w ->
|
||||
if test (w,cr)
|
||||
then runReader (update cr) w
|
||||
else cr
|
||||
overrideInternalRRR test update cr = do
|
||||
b <- test cr
|
||||
if b then update cr else pure cr
|
||||
|
||||
watchUpdateStratR
|
||||
:: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
|
||||
@@ -104,18 +167,6 @@ watchUpdateStratR fs cr = reader $ \w -> case cr ^? crActionPlan . crStrategy of
|
||||
& crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr
|
||||
_ -> cr
|
||||
|
||||
watchUpdateStratRRR
|
||||
:: [ (Creature -> Reader World Bool, Creature -> Reader World Strategy) ]
|
||||
-> Creature
|
||||
-> Reader World Creature
|
||||
watchUpdateStratRRR fs cr = do
|
||||
return undefined fs cr
|
||||
-- reader $ \w -> 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
|
||||
@@ -125,16 +176,15 @@ listGuard (_,z) _ = z
|
||||
|
||||
targetYouWhenCognizantR :: Creature -> Reader World Creature
|
||||
targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crAwarenessLevel . ix 0 of
|
||||
-- Just (Cognizant _) -> cr & crTarget ?~ _creatures w IM.! 0
|
||||
Just (Cognizant _) -> cr {_crTarget = Just $! _creatures w IM.! 0}
|
||||
_ -> cr & crTarget .~ Nothing
|
||||
|
||||
shootTargetWithStratR
|
||||
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
|
||||
-> (World -> Creature -> Creature -> [Action] -> [Action])
|
||||
-- ^ Function for determining shooting strategy given target
|
||||
-> Creature
|
||||
-> Reader World Creature
|
||||
shootTargetWithStratR targFunc strat cr = reader $ \w -> case targFunc cr w of
|
||||
Nothing -> cr
|
||||
Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg
|
||||
--shootTargetWithStratR
|
||||
-- :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
|
||||
-- -> (World -> Creature -> Creature -> [Action] -> [Action])
|
||||
-- -- ^ Function for determining shooting strategy given target
|
||||
-- -> Creature
|
||||
-- -> Reader World Creature
|
||||
--shootTargetWithStratR targFunc strat cr = reader $ \w -> case targFunc cr w of
|
||||
-- Nothing -> cr
|
||||
-- Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg
|
||||
|
||||
Reference in New Issue
Block a user