337 lines
13 KiB
Haskell
337 lines
13 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
module Dodge.Creature.ReaderUpdate (
|
|
doStrategyActions,
|
|
targetYouWhenCognizant,
|
|
overrideMeleeCloseTarget,
|
|
watchUpdateStrat,
|
|
overrideInternal,
|
|
searchIfDamaged,
|
|
-- goToTarget,
|
|
flockACC,
|
|
chaseCritMv,
|
|
crabActionUpdate,
|
|
setMvPosToTargetCr,
|
|
setViewPos,
|
|
hoverCritMv,
|
|
) where
|
|
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Data.Bifunctor
|
|
import Data.List (sortOn)
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
import Dodge.Creature.Perception
|
|
import Dodge.Creature.Radius
|
|
import Dodge.Creature.Vocalization
|
|
import Dodge.Data.CreatureEffect
|
|
import Dodge.Data.World
|
|
import Dodge.Zoning.Creature
|
|
import FoldableHelp
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import Linear
|
|
import RandomHelp
|
|
|
|
overrideMeleeCloseTarget :: World -> Creature -> Creature
|
|
overrideMeleeCloseTarget w cr = maybe cr (tryMeleeAttack cr) $ do
|
|
i <- _targetCr $ _crIntention cr
|
|
w ^? cWorld . lWorld . creatures . ix i
|
|
|
|
tryMeleeAttack :: Creature -> Creature -> Creature
|
|
tryMeleeAttack cr tcr
|
|
| _meleeCooldown (_crType cr) == 0
|
|
&& Just (_crID tcr) == cr ^? crActionPlan . apStrategy . meleeTarget
|
|
&& dist tpos cpos < crRad (cr ^. crType) + crRad (tcr ^. crType) + 5
|
|
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4 =
|
|
cr & crActionPlan . apAction
|
|
.~ DoImpulses [Melee $ _crID tcr] `DoActionThen`
|
|
DoReplicate 10 NoAction
|
|
-- `DoActionThen` DoImpulses
|
|
-- [ChangeStrategy (CloseToMelee $ _crID tcr)]
|
|
-- & crActionPlan . apStrategy .~ MeleeStrike
|
|
| otherwise = cr
|
|
where
|
|
cpos = cr ^. crPos . _xy
|
|
tpos = tcr ^. crPos . _xy
|
|
|
|
setMvPosToTargetCr :: World -> Creature -> Creature
|
|
setMvPosToTargetCr w cr = cr & crIntention . mvToPoint .~ mpos
|
|
where
|
|
int = _crIntention cr
|
|
mtpos = do
|
|
i <- int ^. targetCr
|
|
tpos <- w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
|
|
guard $ hasLOSIndirect (cr ^. crPos . _xy) tpos w
|
|
return tpos
|
|
mpos = mtpos <|> _mvToPoint int
|
|
|
|
setViewPos :: World -> Creature -> Creature
|
|
setViewPos w cr = cr
|
|
& crIntention . viewPoint %~ ((<|> mpos) . (attentionViewPoint w cr <|>))
|
|
where
|
|
mpos = listToMaybe (_soundsToInvestigate $ _crMemory cr)
|
|
|
|
attentionViewPoint :: World -> Creature -> Maybe Point2
|
|
attentionViewPoint w cr = do
|
|
attention <- cr ^? crPerception . cpAttention . getAttentiveTo
|
|
cid <- sortOn snd (IM.toList attention) ^? ix 0 . _1
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix cid
|
|
guard $ visionCheck cr (tcr ^. crPos . _xy) > 0
|
|
tcr ^? crPos . _xy
|
|
|
|
--setTargetMv ::
|
|
-- -- | Function for determining target
|
|
-- (World -> Creature -> Maybe Creature) ->
|
|
-- World ->
|
|
-- Creature ->
|
|
-- Creature
|
|
--setTargetMv targFunc w cr =
|
|
-- maybe
|
|
-- cr
|
|
-- (\ctarg -> cr & crIntention . mvToPoint ?~ (ctarg ^. crPos . _xy))
|
|
-- (targFunc w cr)
|
|
|
|
-- ugly
|
|
flockACC :: World -> Creature -> Creature
|
|
flockACC w cr = fromMaybe cr $ do
|
|
i <- cr ^. crIntention . targetCr
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix i
|
|
let tpos = tcr ^. crPos . _xy
|
|
cpos = cr ^. crPos . _xy
|
|
isFarACC cr' =
|
|
_crGroup cr' == _crGroup cr
|
|
&& _crID cr' /= _crID cr
|
|
&& dist (cr' ^. crPos . _xy) tpos > dist cpos tpos
|
|
macr =
|
|
safeMinimumOn (dist cpos . (^. crPos . _xy))
|
|
. filter isFarACC
|
|
. IM.elems
|
|
$ crsNearCirc cpos 50 w
|
|
return $ case macr of
|
|
Nothing -> cr
|
|
Just acr ->
|
|
let r = crRad (acr ^. crType) + crRad (cr ^. crType) + 10
|
|
horDir = normalizeV (vNormal (cpos -.- tpos))
|
|
horShift =
|
|
if isLHS tpos cpos (acr ^. crPos . _xy)
|
|
then r *.* horDir
|
|
else negate r *.* horDir
|
|
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
|
|
|
|
crabActionUpdate :: Int -> World -> World
|
|
crabActionUpdate cid w = case _apStrategy (_crActionPlan cr) of
|
|
_ | Just tid <- meleel -> w & tocr . crActionPlan . apAction
|
|
.~ DoImpulses [MeleeL tid] `DoActionThen`
|
|
DoReplicate 10 NoAction
|
|
_ | Just tid <- meleer -> w & tocr . crActionPlan . apAction
|
|
.~ DoImpulses [MeleeR tid] `DoActionThen`
|
|
DoReplicate 10 NoAction
|
|
WarningCry -> w
|
|
CloseToMelee tid | aimi tid -> w & tocr . crActionPlan . apAction .~ EvadeAim
|
|
& tocr . crType . dodgeCooldown .~ dc
|
|
& randGen .~ g
|
|
CloseToMelee _ | ma <- cr ^? crActionPlan . apAction , notpath ma -> w
|
|
Wander | Just tid <- cr ^? crIntention . targetCr . _Just
|
|
, canSee tid (cr ^. crID) w -> w & tocr . crActionPlan . apStrategy .~ CloseToMelee tid
|
|
_ -> case cr ^? crIntention . mvToPoint . _Just of
|
|
Just p
|
|
| dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
|
|
w & tocr . crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
|
|
| otherwise ->
|
|
w & tocr . crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
|
|
& tocr . crActionPlan . apStrategy .~ Search
|
|
& tocr . crIntention . mvToPoint .~ Nothing
|
|
_ -> w & tocr %~ viewTarget w
|
|
where
|
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
|
tocr = cWorld . lWorld . creatures . ix cid
|
|
meleel = do
|
|
tid <- cr ^? crIntention . targetCr . _Just
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix tid
|
|
let cpos = cr ^. crPos . _xy
|
|
tpos = tcr ^. crPos . _xy
|
|
guard $ _meleeCooldownL (_crType cr) == 0
|
|
&& Just (_crID tcr) == cr ^? crActionPlan . apStrategy . meleeTarget
|
|
&& dist tpos cpos < crRad (cr ^. crType) + crRad (tcr ^. crType) + 5
|
|
&& (_crDir cr - argV (tpos -.- cpos)) > (-pi / 4)
|
|
&& (_crDir cr - argV (tpos -.- cpos)) <= 0
|
|
&& cr ^?! crType . meleeCooldownR < 15
|
|
return tid
|
|
meleer = do
|
|
tid <- cr ^? crIntention . targetCr . _Just
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix tid
|
|
let cpos = cr ^. crPos . _xy
|
|
tpos = tcr ^. crPos . _xy
|
|
guard $ _meleeCooldownR (_crType cr) == 0
|
|
&& Just (_crID tcr) == cr ^? crActionPlan . apStrategy . meleeTarget
|
|
&& dist tpos cpos < crRad (cr ^. crType) + crRad (tcr ^. crType) + 5
|
|
&& (_crDir cr - argV (tpos -.- cpos)) < pi / 4
|
|
&& (_crDir cr - argV (tpos -.- cpos)) >= 0
|
|
&& cr ^?! crType . meleeCooldownL < 15
|
|
return tid
|
|
(dc,g) = randomR (15,50) (w ^. randGen)
|
|
notpath = \case
|
|
Just NoAction -> False
|
|
Just PathTo {} -> False
|
|
Just AimAt {} -> False
|
|
_ -> True
|
|
aimi tid = fromMaybe False $ do
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix tid
|
|
hp <- cr ^? crHP . _HP
|
|
Aiming <- tcr ^? crStance . posture
|
|
let txy = tcr ^. crPos . _xy
|
|
cxy = cr ^. crPos . _xy
|
|
0 <- cr ^? crType . dodgeCooldown
|
|
return $ hasLOS cxy txy w
|
|
&& abs (nearZeroAngle (tcr^.crDir - argV (cxy - txy))) < 0.3
|
|
&& isWalkable txy cxy w
|
|
&& diffAngles (cr ^. crDir) (argV (txy - cxy)) < 0.1
|
|
&& hp > 0
|
|
|
|
chaseCritMv :: World -> Creature -> Creature
|
|
chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
|
|
WarningCry -> cr
|
|
CloseToMelee cid
|
|
| VocReady == (cr ^. crVocalization) ->
|
|
cr
|
|
& crActionPlan . apAction
|
|
.~ ImpulsesList
|
|
( [Bark soundid] :
|
|
replicate numjits [RandomImpulse thejitter]
|
|
++ [[ChangeStrategy (CloseToMelee cid)]]
|
|
) NoAction
|
|
& resetCrVocCoolDown w
|
|
& crActionPlan . apStrategy .~ WarningCry
|
|
where
|
|
thejitter = RandImpulseCircMove 3
|
|
soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
|
|
numjits = fst $ randomR (15, 25) (_randGen w)
|
|
CloseToMelee _ | ma <- cr ^? crActionPlan . apAction , notpath ma -> cr
|
|
_ -> case cr ^? crIntention . mvToPoint . _Just of
|
|
Just p
|
|
| dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
|
|
cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
|
|
| otherwise ->
|
|
cr & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
|
|
& crActionPlan . apStrategy .~ WatchAndWait
|
|
& crIntention . mvToPoint .~ Nothing
|
|
_ -> viewTarget w cr
|
|
where
|
|
notpath = \case
|
|
Just NoAction -> False
|
|
Just PathTo {} -> False
|
|
Just AimAt {} -> False
|
|
_ -> True
|
|
|
|
hoverCritMv :: World -> Creature -> Creature
|
|
hoverCritMv w cr = case _apStrategy (_crActionPlan cr) of
|
|
WarningCry -> cr
|
|
CloseToMelee _ | ma <- cr ^? crActionPlan . apAction , notpath ma -> cr
|
|
_ -> case cr ^? crIntention . mvToPoint . _Just of
|
|
Just p
|
|
| dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
|
|
cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
|
|
| otherwise ->
|
|
cr & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
|
|
& crActionPlan . apStrategy .~ WatchAndWait
|
|
& crIntention . mvToPoint .~ Nothing
|
|
_ -> viewTarget w cr
|
|
where
|
|
notpath = \case
|
|
Just NoAction -> False
|
|
Just PathTo {} -> False
|
|
Just AimAt {} -> False
|
|
_ -> True
|
|
|
|
--goToTarget :: World -> Creature -> Creature
|
|
--goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of
|
|
-- Just p -> cr & crActionPlan . apAction .~ [PathTo p]
|
|
-- _ -> viewTarget w cr
|
|
|
|
viewTarget :: World -> Creature -> Creature
|
|
viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
|
|
Just p
|
|
| hasLOSIndirect p (cr ^. crPos . _xy) w ->
|
|
cr
|
|
& crActionPlan . apAction .~ TurnToPoint p
|
|
& crIntention . viewPoint .~ Nothing
|
|
& crActionPlan . apStrategy .~ Investigate
|
|
| otherwise ->
|
|
-- cr & crActionPlan . apAction %~ replaceNullWith (PathTo p (DoImpulses [ChangeStrategy Wander]))
|
|
cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
|
|
& crActionPlan . apStrategy .~ Investigate
|
|
Nothing -> cr
|
|
|
|
--replaceNullWith :: a -> [a] -> [a]
|
|
--replaceNullWith x [] = [x]
|
|
--replaceNullWith _ xs = xs
|
|
|
|
doStrategyActions :: Creature -> Creature
|
|
doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
|
|
Just (StrategyActions strat acs) ->
|
|
cr
|
|
-- & crActionPlan . apAction .~ acs
|
|
& crActionPlan . apAction .~ head acs
|
|
& crActionPlan . apStrategy .~ strat
|
|
_ -> cr
|
|
|
|
overrideInternal :: (Creature -> Bool) -> (Creature -> Creature) -> Creature -> Creature
|
|
overrideInternal test update cr
|
|
| test cr = update cr
|
|
| otherwise = cr
|
|
|
|
watchUpdateStrat ::
|
|
[(World -> Creature -> Bool, World -> Creature -> Strategy)] ->
|
|
World ->
|
|
Creature ->
|
|
Creature
|
|
watchUpdateStrat fs w cr = case cr ^? crActionPlan . apStrategy of
|
|
Just WatchAndWait ->
|
|
cr
|
|
& crActionPlan . apStrategy .~ listGuard (map (first uncurry) 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
|
|
|
|
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 ?~ 0
|
|
& crPerception . cpVigilance .~ Vigilant
|
|
_ -> cr & crIntention . targetCr .~ Nothing
|
|
|
|
searchIfDamaged :: Creature -> Creature
|
|
searchIfDamaged cr
|
|
| _crPain cr > 0
|
|
&& _apStrategy (_crActionPlan cr) == WatchAndWait =
|
|
cr & crPerception . cpVigilance .~ Vigilant
|
|
& crActionPlan . apStrategy
|
|
.~ StrategyActions
|
|
LookAround
|
|
[ TurnToPoint (cr ^. crPos . _xy -.- unitVectorAtAngle (_crDir cr))
|
|
`DoActionThen` 40 `WaitThen` bfsThenReturn 500
|
|
]
|
|
| otherwise = cr
|
|
|
|
bfsThenReturn :: Int -> Action
|
|
bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
|
|
|
|
-- 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
|