module Dodge.Creature.State (
    crUpdate,
    doDamage,
) where

import Control.Monad
import Dodge.Targeting.Draw
import Dodge.Data.DoubleTree
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Dodge.Base
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Damage
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.State.WalkCycle
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.ComposedItem
import Dodge.Data.World
import Dodge.DoubleTree
import Dodge.Euse
import Dodge.Hammer
import Dodge.ItEffect
import Dodge.Item.Grammar
import Dodge.Item.HeldOffset
import Dodge.LightSource
import Dodge.Prop.Gib
import Dodge.SoundLogic
import Dodge.Zoning.Creature
import FoldableHelp
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
import qualified Quaternion as Q
import RandomHelp
import qualified SDL
import Shape
import ShapePicture

-- this can almost certainly be made more efficient
foldCr ::
    [Creature -> World -> World] ->
    Creature ->
    World ->
    World
foldCr xs cr w = foldl' f w xs
  where
    f w' g = case w' ^? cWorld . lWorld . creatures . ix (_crID cr) of
        Just cr' -> g cr' w'
        Nothing -> w'

{- | this seems to work, but I am not sure about the ordering:
 previously, the movement was updated before the ai in order to correctly set the oldpos.
 This should be made more sensible: should the movement side effects apply to
 the creature before or after it has moved?
 at what point invSideEffects is applied wrt to when the creature moves
 may affect whether the shield moves correctly
-}
crUpdate :: (Creature -> World -> World) -> Creature -> World -> World
crUpdate f =
    foldCr
        [ doDamage -- these two
        , checkDeath -- must be in this order 24/7/22
        , internalCreatureUpdate
        , f
        , footstepSideEffect
        , updateInv -- upInv must be called before invSideEff 22.05.23
        , invSideEff
        , equipmentEffects
        ]

checkDeath :: Creature -> World -> World
checkDeath cr w
    | _crHP cr > 0 = w
        & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
    | otherwise = w
           & dropByState cr -- the order of
           & removecr       -- these is important
           & stopSoundFrom (CrWeaponSound (_crID cr) 0)
           & corpseOrGib cr
  where
    removecr
        | _crID cr == 0 =
            (cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
                . (cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0)
        -- hack to get around player creature being killed but left with more than 0 hp
        | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing

corpseOrGib :: Creature -> World -> World
corpseOrGib cr = case maxDamageType (_csDamage (_crState cr)) of
    Just (FLAMING, _) -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
    Just (ELECTRICAL, _) -> plNew (cWorld . lWorld . corpses) cpID thecorpse
    Just (POISONDAM, _) -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
    _ | _crPastDamage cr > 200 -> addCrGibs cr
    _ -> plNew (cWorld . lWorld . corpses) cpID thecorpse
  where
    thecorpse = makeDefaultCorpse cr

scorchSPic :: SPic -> SPic
scorchSPic = over _1 $ overColSH (mixColors 0.9 0.1 black . normalizeColor)

poisonSPic :: SPic -> SPic
poisonSPic = over _1 $ overColSH (mixColors 0.5 0.5 green . normalizeColor)

internalCreatureUpdate :: Creature -> World -> World
internalCreatureUpdate cr =
    cWorld . lWorld . creatures . ix (_crID cr)
        %~ ( (crHammerPosition %~ moveHammerUp)
                . updateMovement
           )

{- | Drop items according to the creature state.
 TODO make sure this doesn't mess up any ItemPosition
-}
dropByState :: Creature -> World -> World
dropByState cr w = foldl' (flip (dropItem cr)) w $ case cr ^. crState . csDropsOnDeath of
    DropAll -> IM.keys $ _crInv cr
    DropSpecific xs -> xs
    DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)

doDamage :: Creature -> World -> World
doDamage cr = applyPastDamages cr . applyCreatureDamage dams cr
  where
    dams = _csDamage $ _crState cr

-- TODO generalise shake to arbitrary damage amounts
applyPastDamages :: Creature -> World -> World
applyPastDamages cr w
    | _crPastDamage cr > 200 =
        let (p, g) = runState (randInCirc 3) (_randGen w)
         in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
                & randGen .~ g
    | _crPastDamage cr > 20 =
        let (p, g) = runState (randInCirc 2) (_randGen w)
         in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
                & randGen .~ g
    | _crPastDamage cr > 0 =
        let (p, g) = runState (randInCirc 1) (_randGen w)
         in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
                & randGen .~ g
    | otherwise = w

useEquipment :: Creature -> Int -> World -> World
useEquipment cr i = useE (_eeUse (_uequipEffect $ _itUse itm)) itm cr
  where
    itm = _crInv cr IM.! i

-- a map updating all inventory items
updateInv :: Creature -> World -> World
updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.map itemUpdate

-- a loop going over equipped items
-- maybe this should be done during a different loop (invSideEff)?
equipmentEffects :: Creature -> World -> World
--equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
equipmentEffects cr = alaf Endo foldMap (useEquipment cr) (IM.keys $ _crInvEquipped cr)

-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr
  where
    f it = maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)

updateHeldRootItem :: Creature -> World -> World
updateHeldRootItem cr = fromMaybe id $ do
    invid <- cr ^? crManipulation . manObject . imRootSelectedItem
    itmtree <- invRootTrees (_crInv cr) ^? ix invid
    return $ updateAttachedItems itmtree cr

updateAttachedItems :: LabelDoubleTree ItemLink ComposedItem -> Creature -> World -> World
updateAttachedItems itmtree cr =
    cldtPropagateFold
        chainLinkOrientation
        chainLinkOrientation
        (updateItemWithOrientation cr)
        (heldItemRelativeOrient (_cItem $ _ldtValue itmtree) cr (0, Q.qID))
        (LocLDT TopLDT itmtree)

-- need to check rotation
chainLinkOrientation ::
    (Point3, Q.Quaternion Float) ->
    ComposedItem ->
    ItemLink ->
    ComposedItem ->
    (Point3, Q.Quaternion Float)
chainLinkOrientation mo (CItem par _) (ILink lt f) (CItem child _) = (p + Q.rotate q p1, q * q1)
  where
    (p, q) = mo
    (p1, q1) = f par lt child

updateItemWithOrientation ::
    Creature ->
    (Point3, Q.Quaternion Float) ->
    LocationLDT ItemLink ComposedItem ->
    World ->
    World
updateItemWithOrientation cr m loc@(LocLDT _ itmtree) = case (ci ^. cItem . itType, ci ^. cItemFunction) of
    (HELD TORCH, _) -> shineTorch cr itmtree m
    (HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m
    (TARGETING tt, _) -> updateItemTargeting tt cr itm
    (ATTACH AUGMENTEDHUD, _) -> drawAugmentedHUD loc
    _ -> id
  where
    ci = itmtree ^. ldtValue
    itm = ci ^. cItem

drawAugmentedHUD :: LocationLDT ItemLink ComposedItem -> World -> World
drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
    itm <- con ^? cldtParent . cItem
    return $ w & cWorld . lWorld . flares <>~ drawTargeting itm w

shineTargetLaser :: Creature -> LabelDoubleTree ItemLink ComposedItem -> (Point3, Q.Quaternion Float)
    -> World -> World
shineTargetLaser cr itmtree (p,q) w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
    guard (crIsAiming cr)
    (_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
    i <- mag ^? ldtValue . cItem . itUse . amagLoadStatus . iaLoaded
    guard $ i >= x
    maginvid <- mag ^? ldtValue . cItem . itLocation . ilInvID
    return $ w
        & worldEventFlags . at InventoryChange ?~ ()
        & cWorld . lWorld . creatures . ix (_crID cr) 
            . crInv . ix maginvid . itUse . amagLoadStatus . iaLoaded -~ x
       & cWorld . lWorld . lasers .:~ LaserStart
                        { _lpPhaseV = 1
                        , _lpDir = _crDir cr + argV (Q.qToV2 q)
                        , _lpPos = pos
                        , _lpColor = col
                        , _lpType = TargetingLaser (_itID itm)
                        }
  where
    x = 1
    isammolink AmmoInLink{} = True
    isammolink _ = False
    pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
    cdir = _crDir cr
    itm = itmtree ^. ldtValue . cItem
    --pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
    pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
    cid = _crID cr
    invid = _ilInvID $ _itLocation itm
    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red

shineTorch :: Creature -> LabelDoubleTree ItemLink ComposedItem -> (Point3, Q.Quaternion Float) -> World -> World
shineTorch cr itmtree (p, q) = fromMaybe id $ do
    (_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
    i <- mag ^? ldtValue . cItem . itUse . amagLoadStatus . iaLoaded
    guard $ crIsAiming cr
    guard $ i >= x
    invid <- mag ^? ldtValue . cItem . itLocation . ilInvID
    return $
        (cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 pos'')
            . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . amagLoadStatus . iaLoaded -~ x)
  where
    x = 10
    isammolink AmmoInLink{} = True
    isammolink _ = False
    pos = _crPos cr `v2z` 0 + rotate3 cdir p
    pos'' = pos + rotate3 d (V3 8 0 1.5)
    cdir = _crDir cr
    d = _crDir cr + argV (Q.qToV2 q)

-- this probably needs to be set to null when dropped as well?
-- does this need to be updated if it is not attached to the used root item?
updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
updateItemTargeting tt cr itm w = case tt of
    _ | not isattached -> w 
            & pointittarg .itTgPos .~ Nothing
            & pointittarg .itTgActive .~ False
    TargetRBPress | rbpressed -> w
                & pointittarg .itTgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
                & pointittarg .itTgActive .~ True
    TargetRBPress -> w
            & pointittarg .itTgPos .~ Nothing
            & pointittarg .itTgActive .~ False
    TargetRBCreature -> w & pointittarg %~ setRBCreatureTargeting cr w
    TargetCursor -> w 
        & pointittarg .~ ItTargeting
                (Just (mouseWorldPos (w ^. input) (w ^. wCam)))
                Nothing
                True
  where
    pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
    cid = _crID cr
    invid = _ilInvID $ _itLocation itm
    isattached = itm ^?! itLocation . ilIsAttached
    rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)

setRBCreatureTargeting :: Creature -> World -> ItemTargeting -> ItemTargeting
setRBCreatureTargeting cr w ituse
    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^?itTgID . _Just)
        && canSeeTarget =
        ituse & updatePos &itTgActive .~ True
    | otherwise = ituse &itTgID .~ fmap _crID newtarg & updatePos &itTgActive .~ False
  where
    newtarg =
        safeMinimumOn (dist mwp . _crPos)
            . filter (canseepos . _crPos)
            $ crsNearCirc mwp 40 w
    canseepos p = hasLOS (_crPos cr) p w
    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
    updatePos t' = t' & itTgPos .~ posFromMaybeID (_itTgID t')
    posFromMaybeID Nothing = Nothing
    posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
    canSeeTarget = fromMaybe False $ do
        cid <- ituse ^?itTgID . _Just
        cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
        Just $ hasLOS cpos (_crPos cr) w

itemUpdate :: Item -> Item
itemUpdate = updateAutoRecharge . (itUse %~ useUpdate)

useUpdate :: ItemUse -> ItemUse
useUpdate =
    (heldHammer %~ moveHammerUp)
        . (leftHammer %~ moveHammerUp)
        . (leftDelay . rateTime %~ decreaseToZero)
        . (heldDelay . warmTime %~ decreaseToZero)
        . (heldDelay . rateTime %~ decreaseToZero)

updateAutoRecharge :: Item -> Item
updateAutoRecharge it = case it ^? itUse . leftConsumption of
    Just (AutoRecharging l m t p)
        | l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l + 1) m t t
        | l < m -> it & itUse . leftConsumption . arProgress -~ 1
    _ -> it

updateMovement :: Creature -> Creature
updateMovement cr
    | isFrictionless cr = over crPos (+.+ momentum) cr
    | otherwise = updateWalkCycle cr
  where
    momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
    momentum
        | magV momentum' > 1 = 1 *.* normalizeV momentum'
        | otherwise = momentum'

isFrictionless :: Creature -> Bool
isFrictionless cr = case cr ^? crStance . carriage of
    Just (Boosting _) -> True
    Just Floating -> True
    _ -> False