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

import Dodge.HeldUse
import Dodge.BaseTriggerType
import Dodge.Data.DoubleTree
import Dodge.Item.Orientation
import Control.Applicative
import Control.Monad
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.Damage.Type
--import Dodge.Data.DoubleTree
import Dodge.Data.World
import Dodge.DoubleTree
import Dodge.Euse
import Dodge.HeldUse
import Dodge.Inventory.SelectionList
import Dodge.Item.BackgroundEffect
import Dodge.Item.Grammar
import Dodge.Item.HeldOffset
import Dodge.Item.Location
import Dodge.Item.MaxAmmo
import Dodge.Prop.Gib
import Dodge.SoundLogic
import Dodge.Targeting.Draw
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
        , updateWalkCycle
        , f
        , invRootItemEffs
        , updateHeldRootItem
        ]

-- I have changed the ordering of item/equipment effects, which may have
-- unforseen consequences, be aware

checkDeath :: Creature -> World -> World
checkDeath cr w
    | _crHP cr > 0 =
        w
            & cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
    | _crHP cr <= -200 =
        w
            & dropAll cr -- the order of
            & removecr -- these is important
            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
            & addCrGibs cr
    | _crHP cr > -200 && _crDeathTimer cr < 5 =
        w
            & cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
            & cWorld . lWorld . creatures . ix (_crID cr) . crDeathTimer +~ 1
    | otherwise =
        w
            & dropAll cr -- the order of
            & removecr -- these is important
            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
            & corpseOrGib cr
  where
    removecr
        | _crID cr == 0 = id
        --                 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

-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
    Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
    Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
    Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
    _ -> addcorpse thecorpse
  where
    addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
    thecorpse = makeCorpse cr

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

poisonSPic :: SPic -> SPic
poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)

{- | Drop items according to the creature state.
 TODO make sure this doesn't mess up any ItemPosition
-}
dropAll :: Creature -> World -> World
dropAll cr w = foldl' (flip (dropItem cr)) w $ IM.keys $ _crInv cr

doDamage :: Creature -> World -> World
doDamage cr = applyPastDamages cr . applyCreatureDamage (cr ^. crDamage) cr

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

-- a loop going over all root inventory items
invRootItemEffs :: Creature -> World -> World
invRootItemEffs cr =
    appEndo $
        foldMap
            (reduceLocLDT (Endo . invItemLocUpdate cr) . LocLDT TopLDT)
            (invLDT' (_crInv cr))

invItemLocUpdate :: Creature -> LocationLDT ItemLink OItem -> World -> World
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
    ATTACH BULLETSYNTH -> trySynthBullet loc w
    EQUIP WRIST_ECG | haspulse -> tryUseParent loc w
    COPIER _ -> copierItemUpdate itm cr w
    HELD FLATSHIELD -> rootNotrootEff createShieldWall removeShieldWall itm cr w
    HELD MINIGUNX{}
        | itm ^? itParams . isWarming == Just True ->
            w
                & pointerToItem itm . itParams . isWarming .~ False
        | otherwise ->
            w & pointerToItem itm . itParams . wTime
                %~ (max 0 . subtract 1)
    HELD MACHINEPISTOL{}
        | fromMaybe 0 (itm ^? itParams . wTime) >= _coolEnd (itemTriggerType itm) ->
            w & pointerToItem itm . itParams . wTime
                .~ 0
                & pointerToItem itm . itParams . coolSound .~ Nothing
        | fromMaybe 0 (itm ^? itParams . wTime) == _coolStart (itemTriggerType itm) ->
            w
                & randGen .~ g
                & pointerToItem itm . itParams . wTime +~ 1
                & pointerToItem itm . itParams . coolSound ?~ sid
                & soundContinue (CrWeaponSound (_crID cr) (fromIntegral $ _itID itm)) (_crPos cr) sid (Just 1)
        | fromMaybe 0 (itm ^? itParams . wTime) > _coolStart (itemTriggerType itm) ->
            w
                & pointerToItem itm . itParams . wTime +~ 1
                & soundContinue (CrWeaponSound (_crID cr) (fromIntegral $ _itID itm)) (_crPos cr) (fromMaybe undefined (itm ^? itParams . coolSound . _Just)) (Just 1)
        | itm ^? itParams . isWarming == Just True ->
            w
                & pointerToItem itm . itParams . isWarming .~ False
        | fromMaybe 0 (itm ^? itParams . wTime) >= _warmStart (itemTriggerType itm) ->
            w & pointerToItem itm . itParams . wTime
                .~ _coolStart (itemTriggerType itm)
        | otherwise ->
            w & pointerToItem itm . itParams . wTime
                .~ 0
    _ -> w
  where
    haspulse =
        w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress
            == Just 0
    itm = loc ^. locLDT . ldtValue . _1
    (sid, g) = runState (takeOne [whirdownSmall1S,whirdownSmall2S]) (w ^. randGen)

copierItemUpdate :: Item -> Creature -> World -> World
copierItemUpdate itm cr w = fromMaybe w $ do
    x <- itm ^? itScroll . itsInt
    invid <- itm ^? itLocation . ilInvID
    ip <- itm ^? itType . ibtPathing
    i <- getInventoryPath x ip invid cr
    itm' <- cr ^? crInv . ix i
    v <- getItemValue itm' w cr
    return $ w & pointerToItem itm . itUse . uValue .~ v

doAnyEquipmentEffect :: LocationLDT ItemLink OItem -> Creature -> World -> World
doAnyEquipmentEffect loc cr = case itm ^? itLocation . ilEquipSite . _Just of
    Just _ -> equipBackgroundEffect loc cr
    _ -> id
  where
    itm = loc ^. locLDT . ldtValue . _1

tryUseParent :: LocationLDT ItemLink OItem -> World -> World
tryUseParent loc w = fromMaybe w $ do
    t <- locUp loc
    let t' = t ^. locLDT
    cr <- w ^? cWorld . lWorld . creatures . ix 0
    return $ heldEffect InitialPress t' cr w

trySynthBullet :: LocationLDT ItemLink OItem -> World -> World
trySynthBullet loc w = fromMaybe w $ do
    i <- itm ^? itLocation . ilInvID
    x <- itm ^? itUse . uaParams . apInt
    if x < 100
        then do
            bat <- loc ^? locLDT . ldtLeft . ix 0 . _2 . ldtValue . _1
            j <- bat ^? itLocation . ilInvID
            y <- bat ^. itConsumables
            guard $ y > 0
            return $
                w
                    & cWorld . lWorld . creatures
                        . ix 0
                        . crInv
                        . ix i
                        . itUse
                        . uaParams
                        . apInt
                        +~ 1
                    & cWorld . lWorld . creatures
                        . ix 0
                        . crInv
                        . ix j
                        . itConsumables
                        . _Just
                        -~ 1
        else do
            mag <- loc ^? locLdtContext . cldtParent . _1
            j <- mag ^? itLocation . ilInvID
            y <- mag ^. itConsumables
            ymax <- maxAmmo mag
            guard $ y < ymax
            return $
                w
                    & cWorld . lWorld . creatures
                        . ix 0
                        . crInv
                        . ix i
                        . itUse
                        . uaParams
                        . apInt
                        .~ 0
                    & cWorld . lWorld . creatures
                        . ix 0
                        . crInv
                        . ix j
                        . itConsumables
                        . _Just
                        +~ 1
  where
    itm = loc ^. locLDT . ldtValue . _1

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 :: LDTree ItemLink CItem -> Creature -> World -> World
updateAttachedItems itmtree cr =
    cldtPropagateFold
        chainLinkOrientation
        chainLinkOrientation
        (updateItemWithOrientation cr)
        (heldItemRelativeOrient (itmtree ^. ldtValue . _1) cr (0, Q.qID))
        (LocLDT TopLDT itmtree)

-- need to check rotation
chainLinkOrientation ::
    (Point3, Q.Quaternion Float) ->
    CItem ->
    ItemLink ->
    CItem ->
    (Point3, Q.Quaternion Float)
chainLinkOrientation (p, q) par lt child = (p + Q.rotate q p1, q * q1)
  where
    (p1, q1) = orientAttachment (par ^. _1) lt (child ^. _1)

updateItemWithOrientation ::
    Creature ->
    (Point3, Q.Quaternion Float) ->
    LocationLDT ItemLink CItem ->
    World ->
    World
updateItemWithOrientation cr m loc@(LocLDT _ itmtree) w =
    case (ci ^. _1 . itType, ci ^. _2) of
        (HELD TORCH, _) -> shineTorch cr itmtree m w
        --(HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m w
        (HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr loc w
        (TARGETING tt, _) -> updateItemTargeting tt cr itm w
        (ARHUD, _) -> drawARHUD loc w
        _ -> w
  where
    ci = itmtree ^. ldtValue
    itm = ci ^. _1

drawARHUD :: LocationLDT ItemLink CItem -> World -> World
drawARHUD (LocLDT con _) w = fromMaybe w $ do
    itm <- con ^? cldtParent . _1
    return $
        w & cWorld . lWorld . flares
            <>~ fold
                (drawTargetingAR itm w <|> drawMapperAR itm w)

shineTargetLaser :: Creature -> LocationLDT ItemLink CItem -> World -> World
shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
    guard (crIsAiming cr)
    (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
    i <- mag ^. ldtValue . _1 . itConsumables
    guard $ i >= x
    maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
    return $
        w
            & worldEventFlags . at InventoryChange ?~ ()
            & cWorld . lWorld . creatures . ix (_crID cr)
                . crInv
                . ix maginvid
                . itConsumables
                . _Just
                -~ x
            & cWorld . lWorld . lasers
                .:~ Laser
                    { _lpPhaseV = 1
                    , _lpDir = _crDir cr + argV (Q.qToV2 q)
                    , _lpPos = pos
                    , _lpColor = col
                    , _lpType = TargetingLaser (_itID itm)
                    }
  where
    itmtree = loc ^. locLDT
    (p,q) = heldItemRelativeOrient (locToTop loc ^. locLDT . ldtValue . _1) cr 
        $ orientLocation (V3 0 0 0,Q.qID) (fmap fst loc) (V3 5 0 0,Q.qID)
    x = 1
    isammolink AmmoInLink{} = True
    isammolink _ = False
    pos = _crPos cr + xyV3 (rotate3 cdir p)
    cdir = _crDir cr
    itm = itmtree ^. ldtValue . _1
    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

--shineTargetLaser ::
--    Creature ->
--    LDTree ItemLink CItem ->
--    (Point3, Q.Quaternion Float) ->
--    World ->
--    World
--shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
--    guard (crIsAiming cr)
--    (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
--    i <- mag ^. ldtValue . _1 . itConsumables
--    guard $ i >= x
--    maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
--    return $
--        w
--            & worldEventFlags . at InventoryChange ?~ ()
--            & cWorld . lWorld . creatures . ix (_crID cr)
--                . crInv
--                . ix maginvid
--                . itConsumables
--                . _Just
--                -~ x
--            & cWorld . lWorld . lasers
--                .:~ Laser
--                    { _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 . _1
--    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 ->
    LDTree ItemLink CItem ->
    (Point3, Q.Quaternion Float) ->
    World ->
    World
shineTorch cr itmtree (p, q) = fromMaybe id $ do
    (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
    i <- mag ^. ldtValue . _1 . itConsumables
    guard $ crIsAiming cr
    guard $ i >= x
    invid <- mag ^? ldtValue . _1 . itLocation . ilInvID
    return $
        (cWorld . lWorld . lights .:~ LSParam pos'' 250 0.7)
            . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ 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 $ w ^. cWorld . lWorld . lAimPos) Just
                & pointittarg . itTgActive .~ True
    TargetRBPress ->
        w
            & pointittarg . itTgPos .~ Nothing
            & pointittarg . itTgActive .~ False
    TargetRBCreature -> w & pointittarg %~ setRBCreatureTargeting cr w
    TargetCursor ->
        w
            & pointittarg
                .~ ItTargeting
                    (Just (w ^. cWorld . lWorld . lAimPos))
                    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 = w ^. cWorld . lWorld . lAimPos
    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

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