{-# LANGUAGE TupleSections #-}

module Dodge.Creature.Impulse (impulsiveAIBefore) where

import Data.Maybe
import Linear
import NewInt
import Dodge.Creature.MoveType
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 (w ^. cWorld . lWorld) cr
    MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr
    Turn a -> crup $ cr & crDir +~ a
    TurnToward p a -> crup $ creatureTurnToward p a cr
    TurnTo p -> crup $ creatureTurnTo p cr
    ChangePosture post -> crup $ cr & crStance . posture .~ post
    UseItem -> undefined
--    UseItem -> (useSelectedItem $ _crID cr
--        , cr)
    SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
    Melee cid' ->
        ( hitCr cid'
        , crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
        )
    RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a))
    MakeSound sid -> (soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) 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 -> fromMaybe (crup cr) $ do
--        i <- cr ^? crIntention . targetCr . _Just
--        tcr <- w ^? cWorld . lWorld . creatures . ix i
--        return $ followImpulse cr w (doIntImp f $ _crID tcr)
    ImpulseUseTarget f -> fromMaybe (crup cr) $ do
        i <- cr ^? crIntention . targetCr . _Just
        tcr <- w ^? cWorld . lWorld . creatures . ix i
        return $ followImpulse cr w (doCrImp f tcr)
    ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
    MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) 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 = cr ^. crPos . _xy
    cdir = _crDir cr
    cid = _crID cr
    posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy
    rr a = randomR (- a, a) $ _randGen w
    hitCr i =
         cWorld . lWorld . creatures . ix i . crDamage
            .:~ Blunt 100 (posFromID i) (posFromID i-cpos)