Work on Falling carriage state

This commit is contained in:
2026-04-03 10:32:54 +01:00
parent 18dc469408
commit 43a5817ef3
17 changed files with 79 additions and 68 deletions
+2 -2
View File
@@ -36,7 +36,7 @@ hoverCrit :: Creature
hoverCrit =
defaultCreature
& crName .~ "hoverCrit"
& crHP .~ HP 10000
& crHP .~ HP 1000
& crType .~ HoverCrit 0
& crFaction .~ ColorFaction blue
& crStance . carriage .~ Flying 15 0.975 0
& crStance . carriage .~ Flying 15 0.975
+1 -1
View File
@@ -96,7 +96,7 @@ chaseUpperBody cr = colorSH (_skinUpper cskin)
Just (Walking sa RightForward) -> -f sa
_ -> 0
--tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
f i = ((sLen - 2*i) / sLen)
f i = (sLen - 2*i) / sLen
oneSmooth :: Float -> Float
+1 -1
View File
@@ -51,7 +51,7 @@ applyPastDamages cr w
| HoverCrit {} <- cr ^. crType
, _crPain cr > 50 = w
& cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ 50
& cWorld . lWorld . creatures . ix (_crID cr) . crPos . _z %~ max 12 . (subtract 1)
& cWorld . lWorld . creatures . ix (_crID cr) . crPos . _z %~ max 12 . subtract 1
| HoverCrit {} <- cr ^. crType = w
| _crPain cr > 200 = dojitter 3 100
| _crPain cr > 20 = dojitter 2 10
+19 -13
View File
@@ -2,6 +2,7 @@
module Dodge.Creature.State.WalkCycle (updateCarriage) where
import Data.Maybe
import Dodge.Creature.HandPos
import Linear
import Control.Lens
@@ -10,31 +11,36 @@ import Dodge.SoundLogic
import Sound.Data
updateCarriage :: Int -> World -> World
updateCarriage cid w
| Just cr <- w ^? cWorld . lWorld . creatures . ix cid
, Walking x ff <- cr ^. crStance . carriage
, x >= strideLength cr =
w
updateCarriage cid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
return $ updateCarriage' cid cr w (cr ^. crStance . carriage)
updateCarriage' :: Int -> Creature -> World -> Carriage -> World
updateCarriage' cid cr w = \case
Walking x ff | x >= strideLength cr -> w
& soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos . _xy)
(chooseFootSound ff)
Nothing
& over (cWorld . lWorld . creatures . ix cid . crStance . carriage) resetStride
| Just cr <- w ^? cWorld . lWorld . creatures . ix cid
, z <- cr ^. crPos . _z
, Flying dz x oop <- cr ^. crStance . carriage =
w & cWorld . lWorld . creatures . ix cid . crPos . _xy +~ x *^ f (cr ^. crOldPos . _xy - oop)
Walking {} -> w
Floating -> w
Flying {_zSpeed = dz, _flyInertia = x} ->
w & cWorld . lWorld . creatures . ix cid . crPos . _xy +~ x *^ f (cr ^. crOldPos . _xy - oop ^. _xy)
& cWorld . lWorld . creatures . ix cid . crPos . _z +~ dz
& cWorld . lWorld . creatures . ix cid . crStance . carriage . zSpeed
%~ if z < 17 then min 0.05 . (+0.001) else max (-0.05) . (subtract 0.001)
| otherwise = w
%~ if cr ^. crPos . _z < 17 then min 0.05 . (+0.001) else max (-0.05) . subtract 0.001
Boosting {} -> w
Falling _ _ -> w & cWorld . lWorld . creatures . ix cid . crPos +~
0.99 *^ (cr ^. crOldPos - oop & _z -~ 0.5)
OnGround {} -> w
where
-- limits max speed gained through inertia
-- f = id
oop = cr ^. crOldOldPos
f v | norm v > 10 = 10 *^ signorm v
| otherwise = v
resetStride :: Carriage -> Carriage
resetStride = \case
Walking _ ff -> Walking 0 (normalGait ff)
+1 -1
View File
@@ -99,7 +99,7 @@ twoFlat :: Creature -> Bool
twoFlat = crInAimStance TwoHandFlat
twists :: Creature -> Bool
twists cr = crInAimStance TwoHandTwist cr
twists = crInAimStance TwoHandTwist
-- the use of crOldPos is because the damage position is calculated on the
-- previous frame
+11 -11
View File
@@ -37,7 +37,7 @@ import ShapePicture.Data
updateCreature :: Creature -> World -> World
updateCreature cr
| cr ^. crPos . _z < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
| CrIsCorpse _ <- cr ^. crHP = chasmTestCorpse cr
| CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr) . chasmTestCorpse cr
| null (cr ^? crHP . _HP) = id
| cr ^. crPos . _z < 0 = (tocr . crZVel -~ 0.5) . (tocr . crPos . _z +~ _crZVel cr)
| otherwise = updateLivingCreature cr
@@ -142,8 +142,8 @@ chasmTestLiving cr w
| Flying {} <- cr ^. crStance . carriage = w
| Falling {} <- cr ^. crStance . carriage =
w
& tocr . crZVel -~ 0.5
& tocr . crPos . _z +~ _crZVel cr
-- & tocr . crZVel -~ 0.5
-- & tocr . crPos . _z +~ _crZVel cr
| Just (x, y) <- List.find g (w ^. cWorld . cliffs) =
w
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
@@ -158,22 +158,22 @@ chasmTestLiving cr w
startFalling :: Creature -> Creature
startFalling cr = case cr ^. crStance . carriage of
Walking a b -> cr & crZVel -~ 0.5
& crStance . carriage .~ Falling a b
_ -> cr
Walking a b -> cr & crStance . carriage .~ Falling a b
_ -> cr & crStance . carriage .~ Falling 0 RightForward
chasmTestCorpse :: Creature -> World -> World
chasmTestCorpse cr w
| _crZVel cr < 0 =
w
& tocr . crZVel -~ 0.5
& tocr . crPos . _z +~ _crZVel cr
-- | _crZVel cr < 0 =
-- w
-- & tocr . crZVel -~ 0.5
-- & tocr . crPos . _z +~ _crZVel cr
-- only look for TWO cliffs to push along
| (xy:xys) <- filter g (w ^. cWorld . cliffs) =
w
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
& tocr . crPos . _xy +~ h xy xys
| any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5
-- | any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5
| any f (w ^. cWorld . chasms) = w & tocr %~ startFalling
| otherwise = w
where
+1 -1
View File
@@ -13,7 +13,7 @@ import Geometry
holsterWeapon, drawWeapon :: Action
holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
drawWeapon = DoImpulses [ChangePosture $ Aiming, MakeSound whiteNoiseFadeInS]
drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]
shootTillEmpty :: Action
--shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])