loop/src/Dodge/Creature/ReaderUpdate.hs

-- | 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