module Dodge.Creature.Rationality
    where
import Dodge.Data
import Dodge.Base.Collide
import Dodge.Creature.Action
--import Dodge.Creature.Action.UseItem
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.SoundLogic
import Dodge.SoundLogic.Synonyms
import Geometry

import Data.Maybe
import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Lens
import Control.Monad.Reader
import Data.Monoid

composeInternalAIs 
    :: [World -> Creature -> Creature]
    -> World
    -> Creature
    -> Creature
composeInternalAIs fs w c = foldr ($ w) c fs

impulsiveAIR
    :: (Creature -> Reader World Creature)
    -> Creature
    -> World
    -> (Endo World , Maybe Creature)
impulsiveAIR impf cr w = bimap Endo Just $ followImpulses w . ($ w) . runReader $ impf cr

--impulsiveAI 
--    :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
--    -> World 
--    -> (World -> World,StdGen) 
--    -> Creature 
--    -> ((World -> World,StdGen), Maybe Creature)
--impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w

-- needs cleanup
followImpulses 
    :: World 
    -> Creature 
    -> (World -> World, Creature)
followImpulses w cr
    = foldr 
        (\imp (f , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f , cr''))
        (id, cr) 
        (_crImpulse $ _crActionPlan cr)

followImpulse
    :: Creature
    -> World
    -> Impulse
    -> (World -> World , Creature)
followImpulse cr w imp = case imp of
    Move p  -> (id, crMvBy p cr)
    MoveForward x  -> (id, crMvForward x cr)
    Turn a  -> (id, creatureTurn a cr)
    TurnToward p a -> (id, creatureTurnToward p a cr)
    TurnTo p -> (id, creatureTurnTo p cr)
    ChangePosture post -> (id, cr & crStance . posture .~ post)
    UseItem -> (crUseItem cr, cr)
    SwitchToItem i -> (id, cr & crInvSel .~ i)
    Melee cid ->
        (hitCr cid
        , crMvBy (10 *.* normalizeV (posFromID cid -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown?
    RandomTurn a -> (id, creatureTurn (rr a) cr)
    MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr )
    DropItem -> undefined
    ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
    AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) )
    ArbitraryImpulseFunction f -> (id, f w cr)
    ArbitraryImpulse f -> followImpulse cr w (f cr w) 
    ImpulseUseTargetCID f -> case cr ^? crTarget . _Just of
        Just tcr -> followImpulse cr w (f $ _crID tcr)
        _ -> (id,cr)
    ImpulseUseTarget f -> case cr ^? crTarget . _Just of
        Just tcr -> followImpulse cr w (f tcr)
        _ -> (id,cr)
    ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
    _ -> (id , cr)
  where
    cpos = _crPos cr
    posFromID cid = _crPos $ _creatures w IM.! cid
    rr a = fst $ randomR (-a,a) $ _randGen w
    hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
        . soundOnce hitSound
    addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams 

actionUpdateAI
    :: (World -> Creature -> Creature) -- ^ the function updating the actions
    -> World
    -> Creature
    -> Creature
actionUpdateAI actF w c = performActions w $ actF w c

listGuard :: ([(a -> Bool, b)] , b) -> a -> b
listGuard ( (test,y):ps, z ) x
    | test x = y
    | otherwise = listGuard (ps, z) x
listGuard (_,z) _ = z

performActions :: World -> Creature -> Creature
performActions w cr = cr
    & crActionPlan . crImpulse .~ concat iss
    & crActionPlan . crAction .~ catMaybes mayas
  where
    (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction

performActionsR :: Creature -> Reader World Creature
performActionsR cr = reader $ \w -> performActions w cr


{- | Performing an action means that a creature has some impulses for a frame, and
 updates or deletes the action itself. -}
performAction 
    :: Creature
    -> World
    -> Action
    -> ( [Impulse] , Maybe Action )
performAction cr w ac = case ac of
    AimAtCloseSlow tcid p speed slowSpeed a
        | canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a 
            -> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
        | canSee (_crID cr) tcid w
            -> ([TurnToward tpos speed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
        | safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a 
            -> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
        | otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
      where
        tpos = _crPos (_creatures w IM.! tcid)
    WaitThen 0 newAc -> ([] , Just newAc)
    WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc))
    ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
    ImpulsesList _  -> ([], Nothing)
    DoImpulses imps -> (imps, Nothing)
    DoActionThen fsta afta -> case performAction cr w fsta of
        (imps , Just nxta) -> (imps, Just (DoActionThen nxta afta))
        (imps , Nothing  ) -> (imps, Just afta)
    DoActionWhile f repa -> performAction cr w $ DoActionWhilePartial repa f repa
    DoActionWhilePartial partAc f resetAc
        | f (w,cr) -> case performAction cr w partAc of
            (imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc)
            (imps, _) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc)
        | otherwise -> performAction cr w partAc
    DoActionIf f ifa
        | f (w,cr) -> performAction cr w ifa
        | otherwise -> ([],Nothing)
    DoActionIfElse ifa f elsea
        | f (w,cr)      -> performAction cr w ifa
        | otherwise -> performAction cr w elsea
    DoActionWhileInterrupt repa f afta
        | f (w,cr)       -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta)
        | otherwise -> performAction cr w afta
    DoActions [] -> ([], Nothing)
    DoActions acs -> 
        let (imps, newAcs) = unzip $ map (performAction cr w) acs
        in (concat imps, Just . DoActions $ catMaybes newAcs)
    StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
    PathTo p
        | dist cpos p < 5 -> ([], Nothing)
        | hasLOS cpos p w -> ([TurnToward p (pi/4),MoveForward 3] , Just (PathTo p))
        | otherwise -> ([], Nothing)
    LeadTarget p -> case cr ^? crTarget . _Just of
        Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
        _  -> ([], Nothing)
    UseTargetCID f -> case cr ^? crTarget . _Just of
        Just tcr -> performAction cr w (f $ _crID tcr)
        _ -> ([],Nothing)
    UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _Just
    UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
    ArbitraryAction f -> performAction cr w (f cr w)
    DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
        (imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
        (imp, _) -> (sideImp ++ imp, Nothing)
    DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
    DoReplicatePartial _  0 pac -> performAction cr w pac
    DoReplicatePartial sac t pac -> case performAction cr w pac of
        (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac)
        (imps , _)         -> (imps, Just $ DoReplicatePartial sac (t-1) sac)
    _ -> ([], Nothing)
  where
    cpos = _crPos cr 
    cdir = _crDir cr