142 lines
5.2 KiB
Haskell
142 lines
5.2 KiB
Haskell
module Dodge.Creature.Update (updateCreature) where
|
|
|
|
import Dodge.Creature.Vocalization
|
|
import RandomHelp
|
|
import Data.Maybe
|
|
import Linear
|
|
import NewInt
|
|
import Color
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.List as List
|
|
import Dodge.Barreloid
|
|
--import Dodge.Base.NewID
|
|
import Dodge.Corpse.Make
|
|
import Dodge.Creature.Action
|
|
import Dodge.Creature.Radius
|
|
import Dodge.Creature.State
|
|
import Dodge.Creature.State.WalkCycle
|
|
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 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
|
|
| null (cr ^? crHP . _HP) = id
|
|
| cr ^. crPos . _z < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
|
|
| cr ^. crPos . _z < 0 = (tocr . crZVel -~ 0.5) . (tocr . crPos . _z +~ _crZVel cr)
|
|
| otherwise = updateCreature' cr
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
|
|
updateCreature' :: Creature -> World -> World
|
|
updateCreature' cr =
|
|
chasmTest cr . case _crType cr of
|
|
Avatar{} ->
|
|
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
|
|
. crUpdate cid . yourControl cr
|
|
LampCrit{} -> updateLampoid cr
|
|
BarrelCrit bt -> updateBarreloid bt cr
|
|
AvatarDead -> id
|
|
ChaseCrit {} -> \w -> crUpdate cid . performActions cid
|
|
$ over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
|
|
_ -> crUpdate cid
|
|
where
|
|
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
|
|
. updateWalkCycle cid
|
|
|
|
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 && _crDeathTimer cr < 5 -> w
|
|
& tocr . crDamage .~ []
|
|
& tocr . crDeathTimer +~ 1
|
|
HP _ -> w
|
|
& dropAll cr -- the order of these is possibly important
|
|
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
|
|
& corpseOrGib cr
|
|
_ -> w
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
|
|
-- 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 > 200
|
|
-> addCrGibs cr . sethp CrIsGibs
|
|
. 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
|
|
|
|
chasmTest :: Creature -> World -> World
|
|
chasmTest cr w
|
|
| _crZVel cr < 0 = w & tocr . crZVel -~ 0.5
|
|
& tocr . crPos . _z +~ _crZVel cr
|
|
-- | Just (x, y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms') = w
|
|
| Just (x, y) <- List.find g (w ^. cWorld . cliffs) = w
|
|
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
|
|
& tocr . crPos . _xy -~ normalizeV (vNormal (x - y))
|
|
| any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5
|
|
| otherwise = w
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
|
|
f = circInPolygon (cr ^. crPos . _xy) (crRad $ cr ^. crType)
|
|
|
|
updatePulse :: Pulse -> Pulse
|
|
updatePulse p
|
|
| p ^. pulseProgress >= p ^. pulseRate = p & pulseProgress .~ 0
|
|
| otherwise = p & pulseProgress +~ 1
|