{-# LANGUAGE LambdaCase #-}

module Dodge.Creature.Update (updateCreature) where

--import Dodge.WorldEvent.ThingsHit
import Dodge.Creature.Slime
import Dodge.Creature.Radius
import Dodge.Creature.MoveType
import Dodge.Base.Collide
import Data.List (sortOn)
import Dodge.Zoning.Creature
import Dodge.Creature.ChaseCrit
import Dodge.Creature.Damage
import Color
import Control.Monad
import qualified IntMapHelp as IM
import Data.Maybe
import Dodge.Barreloid
import Dodge.Base.You
-- import Dodge.Base.NewID
import Dodge.Creature.Action
import Dodge.Creature.Picture
import Dodge.Creature.State
import Dodge.Creature.State.WalkCycle
import Dodge.Creature.Vocalization
import Dodge.Creature.YourControl
import Dodge.Damage
import Dodge.Data.Damage.Type
import Dodge.Data.World
import Dodge.Humanoid
import Dodge.Inventory
import Dodge.Lampoid
import Dodge.Prop.Gib
import Dodge.SoundLogic
import FoldableHelp
import Geometry
import LensHelp
import Linear
import NewInt
import qualified Quaternion as Q
import RandomHelp
import Shape
import ShapePicture.Data
import qualified Data.IntSet as IS

-- Should separate out creature movement from other parts here
-- allow for knockbacks etc to be determined as well as intended movements
updateCreature :: Creature -> World -> World
updateCreature cr
    | cr ^. crPos . _z < negate 300 = (cWorld . lWorld . creatures . at (cr ^. crID) %~ destroyCreature) 
        . destroyAllInvItems cr
    | otherwise = case cr ^. crHP of
        CrIsCorpse{} -> cleardamage . updateCarriage (_crID cr) . damageCorpse (_crID cr) cr
        AvatarDestroyed{} -> id
        HP{} -> cleardamage . updateLivingCreature cr
  where
    cleardamage = tocr . crDamage .~ mempty
    tocr = cWorld . lWorld . creatures . ix (_crID cr)

damageCorpse :: Int -> Creature -> World -> World
damageCorpse _ cr w = w & applyCreatureDamage (cr ^. crDamage) cr

updateLivingCreature :: Creature -> World -> World
updateLivingCreature cr = case cr ^. crType of
    Avatar{} ->
        (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
            . crUpdate cid
            . yourControl
    LampCrit{} -> updateLampoid cr
    BarrelCrit bt -> updateBarreloid bt cr
    ChaseCrit{} -> crUpdate cid . performActions cid . updateChaseCrit cid
    CrabCrit{} -> crUpdate cid . performActions cid . crabCritInternal cid
    AutoCrit{} -> crUpdate cid
    SwarmCrit{} -> crUpdate cid
    HoverCrit{} -> crUpdate cid . performActions cid . hoverCritHoverSound cr .
            updateHoverCrit cid
    SlinkCrit{} -> slinkCritUpdate cid
    SlimeCrit{} -> slimeCritUpdate cid
    BeeCrit{} -> crUpdate cid . performActions cid . updateBeeFromPheremones cr cid . updateBeeCrit cr cid
    HiveCrit{} -> crUpdate cid . performActions cid . updateHiveCrit cr cid
  where
    cid = cr ^. crID

updateHiveCrit :: Creature -> Int -> World -> World
updateHiveCrit cr cid w
    | Just x <- cr ^? crType . hiveChildren . to IS.size
    , x < nbees
    , Just y <- cr ^? crType . hiveGestation
    , y == 0 
    , Just z <- cr ^? crType . hiveSlime
    , z >= 400
        = w 
        & tocr . crType . hiveChildren %~ IS.insert nid
        & tocr . crType . hiveGestation .~ 50
        & cWorld . lWorld . creatures . at nid ?~ ncr
        & tocr . crType . hiveSlime -~ 400
    | Just x <- cr ^? crType . hiveChildren . to IS.size
    , x < nbees = w
        & tocr . crType . hiveGestation %~ (max 0 . subtract 1)
    | otherwise = w
  where
    nbees = 15
    tocr = cWorld . lWorld . creatures . ix cid
    nid = IM.newKey $ w ^. cWorld . lWorld . creatures
    ncr = beeCrit & crPos .~ (cr ^. crPos + (0 & _xy +~ 25))
        & crID .~ nid
        & crType . beeHive ?~ cid

updateBeeFromPheremones :: Creature -> Int -> World -> World
updateBeeFromPheremones cr cid w
    | any f (w ^. cWorld . lWorld . beePheremones) = w & cWorld . lWorld . creatures . ix cid . crType . beeAggro .~ 300
    | otherwise = w
  where
    f bp = distance (cr ^. crPos . _xy) (bp ^. bpPos . _xy) < 20

updateBeeCrit :: Creature -> Int -> World -> World
updateBeeCrit cr cid
    | cr ^?! crType . beeAggro > 0 = updateAggroBee cr cid
    | otherwise = beeLifespanCheck cr cid . updateCalmBee cr cid

beeLifespanCheck :: Creature -> Int -> World -> World
beeLifespanCheck cr cid
    | Just ls <- cr ^? crType . beeLifespan
    , Just x <- cr ^? crType . beeSlime
    , ls < 1
    , x < 5
        = cWorld . lWorld . creatures . ix cid . crHP . _HP -~ 1
    | otherwise = id

updateAggroBee :: Creature -> Int -> World -> World
updateAggroBee cr cid w
    | Mounted{} <- cr ^. crStance . carriage = w & tocr . crStance . carriage .~ Flying 0 
    | Just tcr <- atarget
    , distance (tcr ^. crPos . _xy) (cr ^. crPos . _xy) < crRad (cr ^. crType) + crRad (tcr ^. crType) + 1
    , nearZeroAngle (argV (tcr ^. crPos . _xy - cr ^. crPos . _xy) - cr ^. crDir) < pi / 2
    , 0 <- cr ^?! crType . meleeCooldown
        = w & tocr . crPos .~ (cr ^. crOldPos & _xy -~ 5 *^ unitVectorAtAngle (cr ^. crDir))
            & tocr . crType . startStopMv .~ (cr ^?! to crMvType . mvPulseTime)
            & cWorld . lWorld . creatures . ix (tcr ^. crID) . crDamage 
                .:~ Blunt 50 (cxy + crRad (cr ^. crType) *^ vdir) vdir (CrMeleeO (cr ^. crID))
            & tocr . crType . meleeCooldown .~ 20
    | Just tcr <- atarget = w & tocr . crActionPlan . apStrategy .~ CloseToMelee (tcr ^. crID)
        & tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
        & tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
    | Just PathTo{} <- cr ^? crActionPlan . apAction = w & tocr . crType . beeAggro -~ 1
        & tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
    | otherwise = w & tocr . crType . beeAggro -~ 1
        & tocr . crActionPlan . apAction .~ PathTo (cxy + p) NoAction
        & tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
        & randGen .~ g 
  where
    (p,g) = runState (randOnCirc 150) (w ^. randGen)
    atarget = listToMaybe . sortOn (distance cxy . (^.crPos._xy)) . IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w
    vdir = unitVectorAtAngle (cr ^. crDir)
    cxy = cr ^. crPos . _xy
    tocr = cWorld . lWorld . creatures . ix cid
    istarget tcr = t (tcr ^. crType)
        && isJust (tcr ^? crHP . _HP)
        && hasLOS cxy (tcr ^. crPos . _xy) w
    t = \case
        Avatar{} -> True
        ChaseCrit{} -> True
        CrabCrit{} -> True
        _ -> False

-- do bees need to be able to see slime targets?
-- if no path can be made, reset harvest action
-- this should all be simplified
-- should count how many are mounted on an individual slime, try for a different
-- slime if too many
updateCalmBee :: Creature -> Int -> World -> World
updateCalmBee cr cid w 
    | Just hcr <- gethive
    , distance (cr ^. crPos . _xy) (hcr ^. crPos . _xy) < 30 
    , Just x <- cr ^? crType . beeSlime 
    , x >= 50 = w 
        & tocr . crType . beeSlime -~ 50
        & cWorld . lWorld . creatures . ix (hcr ^. crID) . crType . hiveSlime +~ 50
    | Just x <- cr ^? crType . beeSlime 
    , x < 50
    , Just hcr <- gethive
    , distance (cr ^. crPos . _xy) (hcr ^. crPos . _xy) < 30 
    , Just ReturnToHive <- cr ^? crActionPlan . apStrategy = startsearch
    | Just ReturnToHive <- cr ^? crActionPlan . apStrategy = w 
    | Just x <- cr ^? crType . beeSlime 
    , x >= 1500 = starthivereturn
        & randGen .~ gsa
        & tocr . crType . beeLifespan %~ max 0 . subtract sa
    | Just mid <- cr ^? crStance . carriage . mountID
    , mountshakeoff mid = startsearch
    | Nothing <- cr ^? crActionPlan . apStrategy . harvestTarget 
    ,  xs@(_:_) <- IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w 
    , (tcr,g') <- runState (takeOne xs) (w ^. randGen) =
         w & tocr . crActionPlan . apStrategy .~ HarvestFrom (tcr ^. crID)
            & randGen .~ g'
    | Just tid <- cr ^? crStance . carriage . mountID
    , Just SlimeCrit{} <- w ^? cWorld . lWorld . creatures . ix tid . crType = w
        & tocr . crType . beeSlime +~ sspeed
        -- & cWorld . lWorld . creatures . ix tid . crType . slimeRad %~ (sqrt . subtract sspeed . (^(2::Int)))
        & cWorld . lWorld . creatures . ix tid . crType . slimeSlime -~ sspeed
    | Just (tcr,ti) <- gettarg
    , distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.8*crRad (tcr ^. crType) 
--    , Just r <- tcr ^? crType . slimeSlime . to slimeToRad
    , Just d <- tcr ^? crType . slimeCompression
        = w
--        & tocr . crStance . carriage .~ Mounted ti (cr ^. crPos - tcr ^. crPos & _xy %~ compressionScale (vNormal ((1/r) *^d)))
        & tocr . crStance . carriage .~ Mounted ti (cr ^. crPos - tcr ^. crPos & _x %~ (/d) & _y *~ d)
        & tocr . crActionPlan . apAction .~ NoAction
    | Just (tcr,_) <- gettarg = w
            & tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
    | Just (HarvestFrom{}) <- cr ^? crActionPlan . apStrategy = startsearch
    | Just (SearchTimed 0) <- cr ^? crActionPlan . apStrategy = starthivereturn
    | Just PathTo{} <- cr ^? crActionPlan . apAction = w
        & tocr . crActionPlan . apStrategy . searchTimer %~ (max 0 . subtract 1)
    | otherwise = startsearch
  where
    (sa,gsa) = runState (takeOne [0,1]) (w ^. randGen)
    starthivereturn = fromMaybe w $ do
        hcr <- gethive
        return $ w
            & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
            & tocr . crActionPlan . apStrategy .~ ReturnToHive
            & tocr . crStance . carriage %~ dounmount
    dounmount x = case x of
        Flying{} -> x
        _ -> Flying 0
    startsearch = w
        & tocr . crActionPlan . apAction .~ PathTo (cxy + p) NoAction
        & tocr . crStance . carriage %~ dounmount
        & randGen .~ g
        & tocr . crActionPlan . apStrategy .~ SearchTimed 200
    (p,g) = runState (randOnCirc 200) (w ^. randGen)
    cxy = cr ^. crPos . _xy
    mountshakeoff mid = fromMaybe True $ do
        mcr <- w ^? cWorld . lWorld . creatures . ix mid
        SlimeCrit {_slimeSplitTimer = x} <- mcr ^? crType
        return $ isJust x
    --sspeed = 0.05
    sspeed = 5
    gettarg = do
        i <- cr ^? crActionPlan . apStrategy . harvestTarget 
        tcr <-  w ^? cWorld . lWorld . creatures . ix i
        x <- tcr ^? crType . slimeSlime . to slimeToRad
        guard $ x > 12
        return (tcr,i)
    gethive = do
        i <- cr ^? crType . beeHive . _Just
        w ^? cWorld . lWorld . creatures . ix i
    tocr = cWorld . lWorld . creatures . ix cid
    istarget tcr = fromMaybe False $ do
        r <- tcr ^? crType . slimeSlime . to slimeToRad
        return $ r > 12

slimeCritUpdate :: Int -> World -> World
slimeCritUpdate cid w 
    | r < 5 = w & cWorld . lWorld . creatures . at cid .~ Nothing
    | Just hitp <- w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmPos
        , Just hitv <-  w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmVector
        , Just w' <- splitSlimeCrit' hitp hitv cid cr w = w'
    | (cr ^?! crType . slimeIsCompressing) && 1 > p
        = let (w',g) = runState (setSlimeDir cid (cr & crDamage .~ []) w) (w ^. randGen)
            in w' & randGen .~ g
    | otherwise = updateCarriage cid $ w
        & cWorld . lWorld . creatures . ix cid .~ mvslime
        & cWorld . lWorld . creatures . ix cid . crDamage .~ []
        & tocr %~ doSlimeRadChange
        & tocr . crType . slimeSplitTimer %~ fsst
        & tocr . crType . slimeEngulfProgress %~ (max 0 . subtract 0.5)
  where
    fsst Nothing = Nothing
    fsst (Just (x,ps))
        | x > 0 = Just (x-1,ps)
        | otherwise = Nothing
    tocr = cWorld . lWorld . creatures . ix cid
    cr = w ^?! cWorld . lWorld . creatures . ix cid
--    v = 0.1 *^ normalize p 
    v = 0.1 *^ unitVectorAtAngle (cr ^. crDir)
    mvslime = cr & crType . slimeCompression +~ f (0.1/r)
        & crPos . _xy +~ v
        & crType . slimeIsCompressing %~ f'
    f | t = negate
      | otherwise = id
    f'  | p > 1.5 = const True
        | otherwise = id
    t = cr ^?! crType . slimeIsCompressing
    r = cr ^?! crType . slimeSlime . to slimeToRad
    p = cr ^?! crType . slimeCompression

setSlimeDir :: Int -> Creature -> World -> State StdGen World
setSlimeDir cid cr w = do
    i <- state $ randomR (0,1)
    d <- state $ randomR (0,2*pi)
    if i < (r - 11) / 50
        then do
            x <- randInCirc 1
            return $ fromMaybe w $ splitSlimeCrit' (x + cxy) (unitVectorAtAngle d) cid cr w
--        else return $ w & tocr . crType . slimeCompression .~ r *^ unitVectorAtAngle d
        else return $ w & tocr . crDir .~ d
                & tocr . crType . slimeIsCompressing .~ False
  where
    tocr = cWorld . lWorld . creatures . ix cid
    cxy = cr ^. crPos . _xy
    r = cr ^?! crType . slimeSlime . to slimeToRad
    

doSlimeRadChange :: Creature -> Creature
doSlimeRadChange = crType . slimeSlimeChange %~ f
  where
    f x | x > 1000 = x - 1000
        | x < -1000 = x + 1000
        | otherwise = 0

splitSlimeCrit' :: Point2 -> Point2 -> Int -> Creature -> World -> Maybe World
splitSlimeCrit' p v cid cr w = do
    (cr1,cr2) <- splitSlimeCrit p v cr
    let cid' = IM.newKey $ w ^. cWorld . lWorld . creatures
        (s,g) = runState (takeOne [popS,pop1S,pop2S,pop3S]) (w ^. randGen)
    return $ w & cWorld . lWorld . creatures . ix cid .~ cr1
            & cWorld . lWorld . creatures . at cid' ?~ (cr2 & crID .~ cid')
            & soundStart (CrSound cid) (cr ^. crPos . _xy) s Nothing
            & randGen .~ g

splitSlimeCrit :: Point2 -> Point2 -> Creature -> Maybe (Creature, Creature)
splitSlimeCrit p v cr = do
    let mp = closestPointOnLine p (p+v) cxy
        h = r - distance mp cxy
    guard $ h > 0
    let a1 = segmentArea r h
        a2 = pi*r*r - a1
        r1 = sqrt (a1/pi)
        r2 = sqrt (a2/pi)
        mvdir 
            | isLHS p (p+v) cxy = normalize (vNormal v)
            | otherwise = - normalize (vNormal v)
        (ps',qs') 
            | isLHS p (p+v) cxy = (ps,qs)
            | otherwise = (qs,ps)
        c1 = cr' & crPos . _xy .~ mp + r1 *^ mvdir
                & crType . slimeSlime .~ round (r1 ^ (2 :: Int) * 100)
                & crDir .~ argV mvdir
        c2 = cr' & crPos . _xy .~ mp - r2 *^ mvdir
                & crType . slimeSlime .~ round (r2^(2::Int) * 100)
                & crDir .~ argV (-mvdir)
        c1ps = qs' & each +~ cxy - (mp + r1 *^ mvdir) & each %~ rotateV (- c1 ^. crDir)
        c2ps = ps' & each +~ cxy - (mp - r2 *^ mvdir) & each %~ rotateV (- c2 ^. crDir)
    --return (c1 & crType . slimeSplitTimer . _Just . _2 .~ polyInPoly (centroid c1ps) c1ps (slimeOutline c1)
    --    ,c2 & crType . slimeSplitTimer . _Just . _2 .~ polyInPoly (centroid c2ps) c2ps (slimeOutline c2)
    return (c1 & crType . slimeSplitTimer . _Just . _2 .~ f c1ps c1
        ,c2 & crType . slimeSplitTimer . _Just . _2 .~ f c2ps c2
        )
  where
    f xs@(_:_) c = polyInPoly (centroid xs) xs (slimeOutline c)
    f _ _ = mempty
    cxy = cr ^. crPos . _xy
    r = cr ^?! crType . slimeSlime . to slimeToRad
    cr' = cr & crDamage .~ []
        & crType . slimeSlimeChange .~ 0
        & crType . slimeSplitTimer .~ Just (10, mempty)
        & crType . slimeIsCompressing .~ False
        & crType . slimeCompression .~ 1 -- rotateV (argV mvdir) (V2 r1 0)
    (ps,qs) = cutPoly (p-cxy) (p+v-cxy) $ slimeOutline cr & each %~ rotateV (cr ^. crDir)
    

-- h is the height of the segment, ie r - distance to center
segmentArea :: Float -> Float -> Float
segmentArea r h = r*r*acos(1-h/r) - (r-h)*sqrt(h*(2*r-h))

slinkCritUpdate :: Int -> World -> World
slinkCritUpdate cid w =
    w
        & cWorld
        . lWorld
        . creatures
        . ix cid
        . crType
        . slinkSpine
        . each
        . _2
        *~ Q.axisAngle (V3 0 1 0) (pi / 1000)

-- spineWalk :: [Point3Q]
-- spineWalk = replicate 15 (V3

hoverCritHoverSound :: Creature -> World -> World
hoverCritHoverSound cr w = fromMaybe w $ do
    guard $ d < 100
    return $
        soundContinueVol
            (0.5 * (1 - 0.01 * d))
            (CrSound cid)
            cxy
            buzz1S
            (Just 2)
            w
  where
    cxy = cr ^. crPos . _xy
    d = max 0 (dist (you w ^. crPos . _xy) cxy - 100)
    cid = cr ^. crID

{- | 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 :: Int -> World -> World
crUpdate cid =
    checkDeath cid
        . doDamage cid
        . invItemEffs cid
        . updateCarriage cid -- stride appears to be updated elsewhere as well

checkDeath :: Int -> World -> World
checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w

checkDeath' :: Creature -> World -> World
checkDeath' cr w = case cr ^. crHP of
    HP x | x > 0 -> w
    HP x
        | x > -200 && null (cr ^. crDeathTimer) ->
            w & tocr %~ startDeathTimer
    HP x
        | x > -200
        , Just y <- cr ^. crDeathTimer
        , y > 0 -> w & tocr . crDeathTimer . _Just -~ 1
    HP _ ->
        w
            & dropAll cr -- the order of these is possibly important
            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
            & corpseOrGib cr
            & crDeathEffects cr
            & tocr . crStance . carriage %~ toDeathCarriage
    _ -> w
  where
    tocr = cWorld . lWorld . creatures . ix (_crID cr)

crDeathEffects :: Creature -> World -> World
crDeathEffects cr w = case cr ^. crType of
    BeeCrit {_beeHive = mhid} -> beepheremone $ fromMaybe w $ do
        hid <- mhid
        return $ w & cWorld . lWorld . creatures . ix hid . crType . hiveChildren %~ IS.delete (cr ^. crID)
    _ -> w
  where
    beepheremone 
        | Just x <- cr ^? crType . beeLifespan
        ,   x < 1 = id
        | otherwise = cWorld . lWorld . beePheremones .:~ BPheremone (cr ^. crPos) (cr ^. crPos - cr ^. crOldPos) 200

startDeathTimer :: Creature -> Creature
startDeathTimer cr = cr & crDeathTimer ?~ case cr ^. crType of
            HoverCrit{} -> 0
            BeeCrit{} -> 0
            _ -> 5

toDeathCarriage :: Carriage -> Carriage
toDeathCarriage = \case
    Flying{} -> Falling Q.qid Q.qid
    Walking -> OnGround Q.qid
    _ -> Falling Q.qid Q.qid

-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr w =
    w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
        Just CookingDamage ->
            sethp (CrIsCorpse $ scorchSPic thecorpse)
                . dodeathsound CookDeath
        Just PoisonDamage ->
            sethp (CrIsCorpse $ poisonSPic thecorpse)
                . dodeathsound PoisonDeath
        Just PhysicalDamage
            | _crPain cr > 300 ->
                makeCrGibs cr
                    . (cWorld . lWorld . creatures . at (cr ^. crID) %~ destroyCreature)
                    . dodeathsound GibsDeath
        _ ->
            sethp (CrIsCorpse thecorpse)
                . dodeathsound PlainDeath
  where
    dodeathsound dt = f dt . stopSoundFrom (CrMouth cid)
    f dt w' = fromMaybe w' $ do
        let (msid, g) = runState (maybeTakeOne (crDeathSounds cr dt)) (_randGen w')
        sid <- msid
        return $
            w'
                & soundStart (CrMouth cid) (cr ^. crPos . _xy) sid Nothing
                & randGen
                .~ g
    cid = cr ^. crID
    sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
    thecorpse = makeCorpse (w ^. randGen) 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)

-- reverse keys, otherwise two or more inv items will cause errors
dropAll :: Creature -> World -> World
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr

-- startFalling :: Creature -> Creature
-- startFalling cr = case cr ^. crStance . carriage of
--    Walking -> cr & crStance . carriage .~ Falling
--    _ -> cr & crStance . carriage .~ Falling

updatePulse :: Pulse -> Pulse
updatePulse p
    | p ^. pulseProgress >= p ^. pulseRate = p & pulseProgress .~ 0
    | otherwise = p & pulseProgress +~ 1