{-# LANGUAGE TupleSections #-}

module Dodge.Creature.Impulse (
    impulsiveAIBefore,
) where

import Data.Foldable
import Control.Monad.State
import Data.Bifunctor
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Impulse.UseItem
import Dodge.Creature.Vocalization
import Dodge.CreatureEffect
import Dodge.Data.World
import Dodge.FloatFunction
import Dodge.RandImpulse
import Dodge.SoundLogic
import Geometry
import LensHelp
import System.Random

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

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

-- note SwitchToItem doesn't necessarily update the root item correctly
followImpulse :: Creature -> World -> Impulse -> (World -> World, Creature)
followImpulse cr w imp = case imp of
    ImpulseNothing -> (id, cr)
    RandomImpulse rimp ->
        let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
         in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
    Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w 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 -> (useSelectedItem $ _crID cr, cr)
    SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem i i mempty
    Melee cid' ->
        ( hitCr cid'
        , crMvAbsolute (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 $ doWdCrCr f w cr
    ArbitraryImpulse f -> followImpulse cr w (doCrWdImp f cr w)
    ArbitraryImpulseEffect f -> (doCrWdWd f cr, cr)
    ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
        Just tcr -> followImpulse cr w (doIntImp f $ _crID tcr)
        _ -> crup cr
    ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
        Just tcr -> followImpulse cr w (doCrImp f tcr)
        _ -> crup cr
    ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp 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 = doFloatFloat $ _mvTurnRad mvType
    cpos = _crPos cr
    cdir = _crDir cr
    cid = _crID cr
    posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos
    rr a = randomR (- a, a) $ _randGen w
    hitCr i =
        ( cWorld . lWorld . creatures . ix i . crState . csDamage
            .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) (PushBackDamage 5)
        )
            . soundStart (CrSound cid) cpos hitS Nothing