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
    , turnIfDamaged
    , goToTarget
    , flockACC
    , chaseCritMv
    , setMvPos
    , setViewPos
    ) where
import Dodge.Data
import Dodge.Creature.Test
import Dodge.Creature.Volition
import Dodge.Base
import Geometry
import FoldableHelp

import qualified Data.IntMap.Strict as IM
import Control.Lens
import Control.Applicative
import Data.Maybe
import Data.Bifunctor

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 . crImpulse .~ [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 hasLOS (_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 :: (World -> Creature -> Maybe Creature)    -- ^ Function for determining target
    -> 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
            nearACCs = IM.filter isFarACC $ creaturesNearPointI 5 cpos w
            macr = safeMinimumOn (dist cpos . _crPos) nearACCs
            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 _crStrategy (_crActionPlan cr) of
    StrategyActions _ _ -> cr
    WarningCry -> cr
    _ -> case cr ^? crIntention . mvToPoint . _Just of
        Just p -> cr & crActionPlan . crAction .~ [PathTo p]
        _ -> viewTarget w cr

goToTarget :: World -> Creature -> Creature
goToTarget w cr =
    case cr ^? crIntention . mvToPoint . _Just of
        Just p -> cr & crActionPlan . crAction .~ [PathTo p]
        _ -> viewTarget w cr

viewTarget :: World -> Creature -> Creature
viewTarget w cr = do
    case cr ^? crIntention . viewPoint . _Just of
        Just p | hasLOSIndirect p (_crPos cr) w -> cr'
                    & crActionPlan . crAction %~ replaceNullWith (TurnToA p)
                    & crIntention . viewPoint .~ Nothing
               | otherwise -> cr' & crActionPlan . crAction %~ replaceNullWith (PathTo p)
        Nothing -> cr-- & crPerception . crAwakeLevel .~ Lethargic
  where
    cr' = cr & crPerception . crAwakeLevel .~ Vigilant

replaceNullWith :: a -> [a] -> [a]
replaceNullWith x [] = [x]
replaceNullWith _ xs = xs
    
doStrategyActions :: Creature -> Creature
doStrategyActions cr = case cr ^? crActionPlan . crStrategy of
    Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
        & crActionPlan . crStrategy .~ strat
    _ -> cr

reloadOverride :: Creature -> Creature
reloadOverride cr
    | cr ^? crInv . ix (_crInvSel cr) . itConsumption . laLoaded == Just 0 
            && cr ^. crStance . posture == Aiming
        = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions
    | otherwise = cr
  where
    reloadActions = 
        [ holsterWeapon
        , 1 `WaitThen` 
            DoActionWhileInterrupt NoAction (const 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 . crStrategy of
    Just WatchAndWait -> cr 
        & crActionPlan . crStrategy .~ 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 . crAwarenessLevel . ix 0 of
-- so this caused a space leak: be careful with ?~
-- consider changing targeted creature to be just an index
    Just (Cognizant _)  -> _creatures w IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures w IM.! 0
    _                   -> cr & crIntention . targetCr .~ Nothing

turnIfDamaged :: Creature -> Creature
turnIfDamaged cr
    | _crPastDamage cr > 0 = case _crStrategy (_crActionPlan cr) of
        WatchAndWait -> cr & crPerception . crAwakeLevel .~ Vigilant
            & crActionPlan . crStrategy .~ StrategyActions LookAround [TurnToA (_crPos cr -.- unitVectorAtAngle (_crDir cr))]
        _ -> cr
    | otherwise = cr