513 lines
20 KiB
Haskell
513 lines
20 KiB
Haskell
{-# 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
|