Add slime crit, start work on slink crit

This commit is contained in:
2026-04-11 19:09:49 +01:00
parent 95a6c90d01
commit 5052ee7a9e
21 changed files with 699 additions and 537 deletions
+117 -53
View File
@@ -1,16 +1,18 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.Update (updateCreature) where
import qualified Quaternion as Q
import Dodge.Creature.Picture
import Dodge.Base.You
import Control.Monad
import Dodge.Base.Collide
import Dodge.Creature.Radius
import Color
import Control.Monad
import qualified Data.IntMap.Strict 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
@@ -28,6 +30,7 @@ import Geometry
import LensHelp
import Linear
import NewInt
import qualified Quaternion as Q
import RandomHelp
import Shape
import ShapePicture.Data
@@ -44,27 +47,74 @@ updateCreature cr
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{} ->
crUpdate cid . performActions cid . crabCritInternal cid
AutoCrit {} -> crUpdate cid
SwarmCrit {} -> crUpdate cid
HoverCrit {} -> \w ->
crUpdate cid . performActions cid . hoverCritHoverSound cr $
over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
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{} ->
crUpdate cid . performActions cid . crabCritInternal cid
AutoCrit{} -> crUpdate cid
SwarmCrit{} -> crUpdate cid
HoverCrit{} -> \w ->
crUpdate cid . performActions cid . hoverCritHoverSound cr $
over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
SlinkCrit{} -> slinkCritUpdate cid
SlimeCrit{} -> slimeCritUpdate cid
where
cid = cr ^. crID
slimeCritUpdate :: Int -> World -> World
slimeCritUpdate cid w = w
& cWorld . lWorld . creatures . ix cid .~ mvslime
where
txy = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
cr = w ^?! cWorld . lWorld . creatures . ix cid
cxy = cr ^. crPos . _xy
mvslime
| hasLOS cxy txy w = mvslime'
| otherwise = cr
mvslime' = cr & crType . slimeCompression .~ p' + x
& crPos . _xy +~ g (0.5*x)
& crType . slimeIsCompressing %~ (f . f')
& crDir .~ argV (txy-cxy)
g | cr ^?! crType . slimeIsCompressing = negate
| otherwise = id
s | cr ^?! crType . slimeIsCompressing = 2/3
| otherwise = 1.5
f | abs (norm v - norm p') < 0.1 = not
| otherwise = id
v = (s * r) *^ unitVectorAtAngle (cr ^. crDir)
r = crRad (cr ^. crType)
p = cr ^?! crType . slimeCompression
(p',f')
| dot p v > 0 && dot p v > dot p (vNormal v) && dot p v > dot p (-vNormal v) = (p, id)
| dot p (-v) > dot p (vNormal v) && dot p (-v) > dot p (-vNormal v) = (-p, id)
| dot p (vNormal v) > dot p (-vNormal v) = ((r*r/norm p) *^ normalize (vNormal p), not)
| otherwise = (-(r*r/norm p) *^ normalize (vNormal p), not)
x = 0.1 *^ normalize (v - p')
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
@@ -93,7 +143,7 @@ crUpdate cid =
checkDeath cid
. doDamage cid
. invItemEffs cid
. updateCarriage cid -- stride appears to be updated elsewhere as well
. 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
@@ -101,53 +151,66 @@ checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix c
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
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
& 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
& 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
startDeathTimer cr =
cr
& crDeathTimer
?~ case cr ^. crType of
HoverCrit{} -> 0
_ -> 5
toDeathCarriage :: Carriage -> Carriage
toDeathCarriage = \case
Flying {} -> Falling Q.qid Q.qid
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
. sethp (CrDestroyed Gibbed)
. dodeathsound GibsDeath
_ ->
sethp (CrIsCorpse thecorpse)
. dodeathsound PlainDeath
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
. sethp (CrDestroyed Gibbed)
. dodeathsound GibsDeath
_ ->
sethp (CrIsCorpse thecorpse)
. dodeathsound PlainDeath
where
dodeathsound dt = f dt . stopSoundFrom (CrMouth cid)
f dt w' = fromMaybe w' $ do
@@ -156,7 +219,8 @@ corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
return $
w'
& soundStart (CrMouth cid) (cr ^. crPos . _xy) sid Nothing
& randGen .~ g
& randGen
.~ g
cid = cr ^. crID
sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
thecorpse = makeCorpse (w ^. randGen) cr
@@ -171,8 +235,8 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
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
-- startFalling :: Creature -> Creature
-- startFalling cr = case cr ^. crStance . carriage of
-- Walking -> cr & crStance . carriage .~ Falling
-- _ -> cr & crStance . carriage .~ Falling