-- | Functions updating a creature in a Reader World environment module Dodge.Creature.ReaderUpdate ( doStrategyActions, setTargetMv, targetYouWhenCognizant, overrideMeleeCloseTarget, watchUpdateStrat, reloadOverride, overrideInternal, searchIfDamaged, goToTarget, flockACC, chaseCritMv, setMvPos, setViewPos, ) where import Control.Applicative import Control.Lens 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 import Control.Monad overrideMeleeCloseTarget :: Creature -> Creature overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr) tryMeleeAttack :: Creature -> Creature -> Creature tryMeleeAttack cr tcr | _crMeleeCooldown cr == 0 && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi / 4 = cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr] | otherwise = cr where cpos = _crPos cr setMvPos :: World -> Creature -> Creature setMvPos w cr = cr & crIntention . mvToPoint .~ mpos where int = _crIntention cr mtpos = do tpos <- _crPos <$> _targetCr int if hasLOSIndirect (_crPos cr) tpos w then Just tpos else Nothing mpos = mtpos <|> _mvToPoint int -- <|> listToMaybe (_soundsToInvestigate $ _crMemory cr) setViewPos :: Creature -> Creature setViewPos cr = cr & crIntention . viewPoint %~ (<|> mpos) where mpos = listToMaybe (_soundsToInvestigate $ _crMemory cr) 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 _ -> 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] & 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 = do case cr ^? crIntention . viewPoint . _Just of Just p | hasLOSIndirect p (_crPos cr) w -> cr' & crActionPlan . apAction %~ replaceNullWith ( TurnToPoint p `DoActionThen` 40 `WaitThen` lookAroundSelf `DoActionThen` 20 `WaitThen` lookAroundSelf ) & crIntention . viewPoint .~ Nothing | otherwise -> cr' & crActionPlan . apAction %~ replaceNullWith (PathTo p) Nothing -> cr -- & crPerception . crAwakeLevel .~ Lethargic where cr' = cr & crPerception . cpVigilance .~ Vigilant 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 reloadOverride :: Creature -> Creature reloadOverride cr = fromMaybe cr $ do guard $ cr ^. crStance . posture == Aiming itRef <- cr ^? crInvSel . isel . ispItem guard $ cr ^? crInv . ix itRef . itUse . heldConsumption . laLoaded == Just 0 return $ cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions where reloadActions = [ holsterWeapon , 1 `WaitThen` DoActionWhileInterrupt NoAction (WdCrBlfromCrBl CrIsReloading) (DoImpulses [ChangeStrategy WatchAndWait]) ] 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) _ -> cr & crIntention . targetCr .~ Nothing searchIfDamaged :: Creature -> Creature searchIfDamaged cr | _crPastDamage cr > 0 = case _apStrategy (_crActionPlan cr) of WatchAndWait -> cr & crPerception . cpVigilance .~ Vigilant & crActionPlan . apStrategy .~ StrategyActions LookAround [ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr)) `DoActionThen` 40 `WaitThen` bfsThenReturn 500 ] _ -> cr | 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