justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work on Falling carriage state

Browse Source
This commit is contained in:
justin
2026-04-03 10:32:54 +01:00
parent 18dc469408
commit 43a5817ef3
17 changed files with 79 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/ChaseCrit.hs
+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
src/Dodge/Creature/Picture.hs
+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
src/Dodge/Creature/State.hs
+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
src/Dodge/Creature/State/WalkCycle.hs
+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)
src/Dodge/Creature/Test.hs
+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
src/Dodge/Creature/Update.hs
+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
src/Dodge/Creature/Volition.hs
+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])
src/Dodge/Data/Creature.hs
+1
View File
@@ -35,6 +35,7 @@ import Geometry.Data
data Creature = Creature
{ _crPos :: Point3
, _crOldPos :: Point3
, _crOldOldPos :: Point3
, _crZVel :: Float
, _crDir :: Float
, _crMvDir :: Float
src/Dodge/Data/Creature/Stance.hs
+1 -1
View File
@@ -21,7 +21,7 @@ data Stance = Stance
data Carriage
= Walking {_strideAmount :: Float, _footForward :: FootForward}
| Floating
| Flying {_zSpeed :: Float, _flyInertia :: Float, _oldOldPos :: Point2}
| Flying {_zSpeed :: Float, _flyInertia :: Float}
| Boosting Point2
| Falling {_fallFlail :: Float, _fallFoot :: FootForward}
| OnGround
src/Dodge/Default/Creature.hs
+1
View File
@@ -14,6 +14,7 @@ defaultCreature =
Creature
{ _crPos = V3 0 0 0
, _crOldPos = V3 0 0 0
, _crOldOldPos = V3 0 0 0
-- , _crZ = 0
, _crZVel = 0
, _crDir = 0
src/Dodge/Path.hs
+1 -1
View File
@@ -82,7 +82,7 @@ makePathBetween = makePathUsing $ not . pathEdgeObstructed
makePathBetween' :: (Point2 -> Point2 -> World -> Bool) -> (Set.Set EdgeObstacle -> Bool)
-> Point2 -> Point2 -> World -> Maybe [Int]
makePathBetween' t1 t2 = makePathUsing' t1 $ t2
makePathBetween' = makePathUsing'
pathEdgeObstructed :: Set.Set EdgeObstacle -> Bool
pathEdgeObstructed pe = any (`Set.member` pe) [WallObstacle WallNotAutoOpen, ChasmObstacle]
src/Dodge/Prop/Draw.hs
+2 -2
View File
@@ -20,9 +20,9 @@ debrisSPic db = translateSP (_dbPos db & _z +~ 1) . overPosSP (Q.rotate (_dbRot
Gib x col -> noPic $ drawGib x col
BlockDebris m -> noPic . colorSH m $ cubeShape 4
--MetalDebris c -> noPic . colorSH c $ upperPrismPolySU 1 $ [0, V2 5 0, V2 4 2]
MetalDebris c -> noPic . colorSH c $ upperPrismPolySU 1 $ [0, V2 8 0, V2 6 3]
MetalDebris c -> noPic . colorSH c $ upperPrismPolySU 1 [0, V2 8 0, V2 6 3]
--MetalDebris c -> noPic . colorSH c $ upperPrismPolySU 1 $ [0, V2 10 0, V2 8 4]
GlassDebris -> noPic . colorSH azure $ upperPrismPoly Small Undesired 1 $ [0, V2 8 0, V2 6 3]
GlassDebris -> noPic . colorSH azure $ upperPrismPoly Small Undesired 1 [0, V2 8 0, V2 6 3]
propSPic :: Prop -> SPic
propSPic pr =
src/Dodge/Room/LasTurret.hs
+1 -1
View File
@@ -399,7 +399,7 @@ lasCenRunClose1 = do
-- (alinks,blinks) <- shufflePair (bllinks,brlinks)
-- (alinks,blinks) <- shufflePair (bllinks,tmllink)
lnks <- shuffle [bllinks, brlinks, tmllink, tmrlink]
let alinks = lnks !! 0
let alinks = head lnks
blinks = lnks !! 1
outwall <-
takeOne
src/Dodge/Room/Link.hs
+1 -1
View File
@@ -75,7 +75,7 @@ shiftRoomShiftToLink :: (Point2, Float) -> (Point2, Float) -> Room -> Room
shiftRoomShiftToLink l inlink r =
shiftRoomShiftBy l
. shiftRoomShiftBy (0, pi - a)
$ shiftRoomShiftBy (0 - p, 0) r
$ shiftRoomShiftBy (- p, 0) r
where
(p, a) = inlink
src/Dodge/Update.hs
+1 -1
View File
@@ -579,7 +579,7 @@ updateTerminal tm w = fromMaybe w $ do
setOldPos :: Creature -> Creature
setOldPos cr = cr & crOldPos .~ _crPos cr
& crStance . carriage . oldOldPos .~ cr ^. crOldPos . _xy
& crOldOldPos .~ cr ^. crOldPos
--doRewind :: World -> World
--doRewind w = case w ^. cwTime . maybeWorld of