{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Impulse
    ( impulsiveAI
    , followImpulses
    , 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 Data.Bifunctor
--import Data.Maybe

impulsiveAI :: (World -> Creature -> Creature)
    -> Creature
    -> World
    -> (World -> World , Creature)
impulsiveAI f cr w = followImpulses w $ f w cr

followThenClearImpulses :: World -> Creature -> (World -> World, Creature)
followThenClearImpulses w = second f . followImpulses w
  where
    f = crActionPlan . crImpulse .~ []

followImpulses :: World -> Creature -> (World -> World, Creature)
followImpulses w cr = foldr f (id, cr) (_crImpulse $ _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
    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 .~ i
    Melee cid'      -> (hitCr cid'
        , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
    RandomTurn a    -> crup $ creatureTurn (rr a) cr
    MakeSound sid   -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
    DropItem        -> undefined
    ChangeStrategy strat    -> crup $ cr & crActionPlan . crStrategy .~ strat
    AddGoal gl      -> crup $ cr & crActionPlan . crGoal .:~ gl 
    ArbitraryImpulseFunction f  -> crup $ f w cr
    ArbitraryImpulse f  -> followImpulse cr w (f cr w) 
    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 = fst $ randomR (-a,a) $ _randGen w
    hitCr i = (creatures . ix i . crState . crDamage 
        .:~ Damage Blunt 100 cpos (posFromID i) (posFromID i) NoDamageEffect
        )
        . soundStart (CrSound cid) cpos hitS Nothing