{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Impulse
    ( impulsiveAIBefore
    , followThenClearImpulses
    ) where
import Dodge.Data
import Dodge.Creature.Vocalization
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Impulse.UseItem
import Dodge.SoundLogic
import Geometry
import LensHelp

import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Monad.State
import Data.Bifunctor
--import Data.Maybe
--
impulsiveAIBeforeAfter 
    :: (World -> Creature -> Creature)
    -> (World -> Creature -> Creature)
    -> Creature -> World -> World
impulsiveAIBeforeAfter startup endup cr w = w' & creatures . ix (_crID cr) .~ endup w' cr'
  where
    w' = g w
    (g,cr') = impulsiveAI startup cr w

impulsiveAIBefore :: (World -> Creature -> Creature)
    -> Creature -> World -> World
impulsiveAIBefore f cr w = g w & creatures . ix (_crID cr) .~ cr'
  where
    (g,cr') = impulsiveAI f cr w

impulsiveAI 
    :: (World -> Creature -> Creature) -- | internal creature update
    -> Creature
    -> World
    -> (World -> World , Creature)
impulsiveAI f cr w = followImpulses w $ f w cr


followThenClearImpulses :: Creature -> World -> World
followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . apImpulse .~ [])

followImpulses :: World -> Creature -> (World -> World, Creature)
followImpulses w cr = foldr f (id, cr) (_apImpulse $ _crActionPlan cr)
  where
    f imp (theupdate,cr') = first (. theupdate) $ followImpulse cr' w imp

followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
followImpulse cr w imp = case imp of
    RandomImpulse rimp -> 
        let (newimp,newgen) = runState rimp (_randGen w)
        in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
    Bark sid        -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
    Move p          -> crup $ crMvBy p cr
    MoveForward x   -> crup $ crMvForward x cr
    Turn a          -> crup $ creatureTurn a cr
    TurnToward p a  -> crup $ creatureTurnToward p a cr
    TurnTo p        -> crup $ creatureTurnTo p cr
    ChangePosture post  -> crup $ cr & crStance . posture .~ post
    UseItem         -> (useItem cr, cr)
    SwitchToItem i  -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction
    Melee cid'      -> (hitCr cid'
        , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
    RandomTurn a    -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr)
    MakeSound sid   -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
    DropItem        -> undefined
    ChangeStrategy strat    -> crup $ cr & crActionPlan . apStrategy .~ strat
    AddGoal gl      -> crup $ cr & crActionPlan . apGoal .:~ gl 
    ArbitraryImpulseFunction f  -> crup $ f w cr
    ArbitraryImpulse f  -> followImpulse cr w (f cr w) 
    ArbitraryImpulseEffect f -> (f cr, cr)
    ImpulseUseTargetCID f   -> case cr ^? crIntention . targetCr . _Just of
        Just tcr -> followImpulse cr w (f $ _crID tcr)
        _        -> crup cr
    ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
        Just tcr -> followImpulse cr w (f tcr)
        _        -> crup cr
    ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
    MvForward       -> crup $ crMvForward speed cr
    MvTurnToward p  -> crup
        $ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
  where
    crup = (id,)
    mvType = _crMvType cr
    speed = _mvSpeed mvType
    turnRad = _mvTurnRad mvType
    cpos = _crPos cr
    cdir = _crDir cr
    cid  = _crID cr
    posFromID cid' = _crPos $ _creatures w IM.! cid'
    rr a = randomR (-a,a) $ _randGen w
    hitCr i = (creatures . ix i . crState . csDamage 
        .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
        )
        . soundStart (CrSound cid) cpos hitS Nothing