236 lines
8.2 KiB
Haskell
236 lines
8.2 KiB
Haskell
module Dodge.Creature.ReaderUpdate (
|
|
doStrategyActions,
|
|
setTargetMv,
|
|
targetYouWhenCognizant,
|
|
overrideMeleeCloseTarget,
|
|
watchUpdateStrat,
|
|
overrideInternal,
|
|
searchIfDamaged,
|
|
goToTarget,
|
|
flockACC,
|
|
chaseCritMv,
|
|
setMvPos,
|
|
setViewPos,
|
|
) where
|
|
|
|
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 . apImpulse .~ [Melee $ _crID tcr]
|
|
& crActionPlan . apAction
|
|
.~ [ DoReplicate 10 NoAction
|
|
`DoActionThen` DoImpulses
|
|
[ChangeStrategy (CloseToMelee $ _crID tcr)]
|
|
]
|
|
& crActionPlan . apStrategy .~ MeleeStrike
|
|
| otherwise = cr
|
|
where
|
|
cpos = cr ^. crPos . _xy
|
|
tpos = tcr ^. crPos . _xy
|
|
|
|
setMvPos :: World -> Creature -> Creature
|
|
setMvPos 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
|
|
$ 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
|
|
|
|
chaseCritMv :: World -> Creature -> Creature
|
|
chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
|
|
StrategyActions _ _ -> cr
|
|
WarningCry -> cr
|
|
MeleeStrike -> cr
|
|
CloseToMelee cid
|
|
| Just 0 == (cr ^? crVocalization . vcCoolDown) ->
|
|
cr
|
|
& crActionPlan . apAction
|
|
.:~ ImpulsesList
|
|
( [Bark soundid] :
|
|
replicate numjits [RandomImpulse thejitter]
|
|
++ [[ChangeStrategy (CloseToMelee cid)]]
|
|
)
|
|
& crVocalization . vcCoolDown .~ 10
|
|
& crActionPlan . apStrategy .~ WarningCry
|
|
where
|
|
thejitter = RandImpulseCircMove 3
|
|
soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
|
|
numjits = fst $ randomR (15, 25) (_randGen w)
|
|
_ -> case cr ^? crIntention . mvToPoint . _Just of
|
|
Just p
|
|
| dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
|
|
cr & crActionPlan . apAction .~ [PathTo p]
|
|
| otherwise ->
|
|
cr & crActionPlan . apAction .~ [bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
|
|
& crActionPlan . apStrategy .~ WatchAndWait
|
|
& crIntention . mvToPoint .~ Nothing
|
|
_ -> 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
|
|
|
|
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)
|
|
& 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 . 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
|