loop/src/Dodge/Creature/ReaderUpdate.hs

{- | Functions updating a creature in a Reader World environment -}
module Dodge.Creature.ReaderUpdate
    ( doStrategyActionsR
    , setTargetMv
    , targetYouWhenCognizantR
    , overrideMeleeCloseTargetR
    , watchUpdateStratR
    , reloadOverrideR
    , overrideInternalRRR
    , goToTarget
    , flockACCR
    , setMvPos
    , setViewPos
    )
    where
import Dodge.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Memory.Data
import Dodge.Creature.Test
import Dodge.Creature.Volition
import Dodge.Creature.Perception.Data
import Dodge.Base
import Dodge.Base.Collide
import Geometry
import FoldableHelp

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

overrideMeleeCloseTargetR 
    :: Creature 
    -> Reader World Creature
overrideMeleeCloseTargetR cr = return $ 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 . crStrategy .~ StrategyActions MeleeStrike meleeActions
        = cr & crActionPlan . crImpulse .~ [Melee $ _crID tcr]
    | otherwise = cr
  where
    cpos = _crPos cr

setMvPos :: Creature -> Reader World Creature
setMvPos cr = pure $ cr & crIntention . mvToPoint .~ mpos
  where
    int = _crIntention cr
    mpos = (_crPos <$> _targetCr int) 
        <|> _mvToPoint int 
--        <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)

setViewPos :: Creature -> Reader World Creature
setViewPos cr = pure $ cr & crIntention . viewPoint %~ (<|> mpos)
  where
    mpos = listToMaybe (_soundsToInvestigate $ _crMemory cr)

setTargetMv
    :: (Creature -> Reader World (Maybe Creature))    -- ^ Function for determining target
    -> Creature 
    -> Reader World Creature 
setTargetMv targFunc cr = do
    targ <- targFunc cr
    case targ of
        Nothing -> pure cr
        Just crTarg -> pure $ cr & crIntention . mvToPoint ?~ _crPos crTarg
flockACCR :: Creature -> Reader World Creature
flockACCR cr = do
    case cr ^? crIntention . targetCr . _Just of
        Nothing -> pure cr
        Just tcr -> do
            w <- ask
            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
            case macr of
                Nothing  -> pure cr
                Just acr -> do
                    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
                    pure $ cr & crIntention . mvToPoint ?~ tpos +.+ horShift

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

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

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

reloadOverrideR
    :: Creature 
    -> Reader World Creature
reloadOverrideR cr
    | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 
            && cr ^. crStance . posture == Aiming
        = return $ cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions
    | otherwise = return cr
  where
    reloadActions = 
        [ holsterWeapon
        , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait])
        ]

overrideInternalRRR
    :: (Creature -> Reader World Bool)
    -> (Creature -> Reader World Creature)
    -> Creature
    -> Reader World Creature
overrideInternalRRR test update cr = do
    b <- test cr
    if b then update cr else pure cr

watchUpdateStratR
    :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
    -> Creature
    -> Reader World Creature
watchUpdateStratR fs cr = reader $ \w -> case cr ^? crActionPlan . crStrategy of
    Just WatchAndWait -> cr 
        & crActionPlan . crStrategy .~ listGuard (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

targetYouWhenCognizantR :: Creature -> Reader World Creature
targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenessLevel . ix 0 of
    Just (Cognizant _)  -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
    _                   -> cr & crIntention . targetCr .~ Nothing