226 lines
7.9 KiB
Haskell
226 lines
7.9 KiB
Haskell
module Dodge.Creature.ReaderUpdate (
|
|
doStrategyActions,
|
|
setTargetMv,
|
|
targetYouWhenCognizant,
|
|
overrideMeleeCloseTarget,
|
|
watchUpdateStrat,
|
|
overrideInternal,
|
|
searchIfDamaged,
|
|
goToTarget,
|
|
flockACC,
|
|
chaseCritMv,
|
|
setMvPos,
|
|
setViewPos,
|
|
) where
|
|
|
|
import RandomHelp
|
|
import Dodge.Creature.Perception
|
|
import qualified IntMapHelp as IM
|
|
import Data.List (sortOn)
|
|
import Control.Applicative
|
|
import LensHelp
|
|
--import Control.Monad
|
|
import Data.Bifunctor
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
--import Dodge.Creature.Volition
|
|
import Dodge.Data.CreatureEffect
|
|
import Dodge.Data.World
|
|
import Dodge.Zoning.Creature
|
|
import FoldableHelp
|
|
import Geometry
|
|
|
|
overrideMeleeCloseTarget :: Creature -> Creature
|
|
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
|
|
|
|
tryMeleeAttack :: Creature -> Creature -> Creature
|
|
tryMeleeAttack cr tcr
|
|
| _crMeleeCooldown cr == 0
|
|
&& Just (_crID tcr) == cr ^? crActionPlan . apStrategy . meleeTarget
|
|
&& dist tpos cpos < _crRad cr + _crRad tcr + 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 = _crPos cr
|
|
tpos = _crPos tcr
|
|
|
|
setMvPos :: World -> Creature -> Creature
|
|
setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
|
|
where
|
|
int = _crIntention cr
|
|
mtpos = do
|
|
tpos <- _crPos <$> _targetCr int
|
|
guard $ hasLOSIndirect (_crPos cr) 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 (_crPos tcr) > 0
|
|
return (_crPos tcr)
|
|
|
|
setTargetMv ::
|
|
-- | Function for determining target
|
|
(World -> Creature -> Maybe Creature) ->
|
|
World ->
|
|
Creature ->
|
|
Creature
|
|
setTargetMv targFunc w cr =
|
|
maybe
|
|
cr
|
|
(\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
|
|
(targFunc w cr)
|
|
|
|
-- ugly
|
|
flockACC :: World -> Creature -> Creature
|
|
flockACC w cr = case cr ^? crIntention . targetCr . _Just of
|
|
Nothing -> cr
|
|
Just tcr ->
|
|
let tpos = _crPos tcr
|
|
cpos = _crPos cr
|
|
isFarACC cr' =
|
|
_crGroup cr' == _crGroup cr
|
|
&& _crID cr' /= _crID cr
|
|
&& dist (_crPos cr') tpos > dist cpos tpos
|
|
macr =
|
|
safeMinimumOn (dist cpos . _crPos)
|
|
. filter isFarACC
|
|
$ crsNearCirc cpos 50 w
|
|
in case macr of
|
|
Nothing -> cr
|
|
Just acr ->
|
|
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
|
|
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 (_vcWarnings (_crVocalization cr))) (_randGen w)
|
|
numjits = fst $ randomR (15, 25) (_randGen w)
|
|
_ -> case cr ^? crIntention . mvToPoint . _Just of
|
|
Just p
|
|
| dist (_crPos cr) p > _crRad cr -> 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
|
|
|
|
--lookAroundSelf :: Action
|
|
--lookAroundSelf = UseSelf CrTurnAround
|
|
|
|
viewTarget :: World -> Creature -> Creature
|
|
viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
|
|
Just p
|
|
| hasLOSIndirect p (_crPos cr) w ->
|
|
cr
|
|
& crActionPlan . apAction
|
|
.~ [TurnToPoint p]
|
|
-- %~ replaceNullWith
|
|
-- ( 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 ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
|
|
& crPerception . cpVigilance .~ Vigilant
|
|
_ -> cr & crIntention . targetCr .~ Nothing
|
|
|
|
searchIfDamaged :: Creature -> Creature
|
|
searchIfDamaged cr
|
|
| _crPastDamage cr > 0
|
|
&& _apStrategy (_crActionPlan cr) == WatchAndWait =
|
|
cr & crPerception . cpVigilance .~ Vigilant
|
|
& crActionPlan . apStrategy
|
|
.~ StrategyActions
|
|
LookAround
|
|
[ TurnToPoint (_crPos cr -.- 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
|