loop/src/Dodge/Creature/Update.hs

{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.Update (updateCreature) where

import Dodge.Base.You
import Control.Monad
import Color
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Barreloid
-- import Dodge.Base.NewID
import Dodge.Corpse.Make
import Dodge.Creature.Action
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 RandomHelp
import Shape
import ShapePicture.Data

-- 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 = (tocr . crHP .~ CrDestroyed Pitted) . destroyAllInvItems cr
    | CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr)
    | null (cr ^? crHP . _HP) = id
    | otherwise = updateLivingCreature cr
  where
    tocr = cWorld . lWorld . creatures . ix (_crID cr)

updateLivingCreature :: Creature -> World -> World
updateLivingCreature cr =
    case _crType cr of
        Avatar{} ->
            (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
                . crUpdate cid
                . yourControl
        LampCrit{} -> updateLampoid cr
        BarrelCrit bt -> updateBarreloid bt cr
        ChaseCrit{} -> \w ->
            crUpdate cid . performActions cid $
                over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
        CrabCrit{} -> \w ->
            crUpdate cid . performActions cid $
                over (cWorld . lWorld . creatures . ix cid) (crabCritInternal w) w
        AutoCrit {} -> crUpdate cid
        SwarmCrit {} -> crUpdate cid
        HoverCrit {} -> \w ->
            crUpdate cid . performActions cid . hoverCritHoverSound cr $
                over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
  where
    cid = cr ^. crID

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 & tocr . crDamage .~ []
    HP x | x > -200 && null (cr ^. crDeathTimer)
        -> w & tocr %~ startDeathTimer
    HP x | x > -200 
        ,Just y <- cr ^. crDeathTimer
        , y > 0 ->
            w
                & tocr . crDamage .~ []
                & tocr . crDeathTimer . _Just -~ 1
    HP _ ->
        w
            & dropAll cr -- the order of these is possibly important
            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
            & corpseOrGib cr
            & tocr . crStance . carriage %~ toDeathCarriage
    _ -> w
  where
    tocr = cWorld . lWorld . creatures . ix (_crID cr)

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

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

-- 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 ->
        sethp (CrIsCorpse $ scorchSPic thecorpse)
            . dodeathsound CookDeath
    Just PoisonDamage ->
        sethp (CrIsCorpse $ poisonSPic thecorpse)
            . dodeathsound PoisonDeath
    Just PhysicalDamage
        | _crPain cr > 300 ->
            makeCrGibs cr
                . sethp (CrDestroyed Gibbed)
                . 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 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