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

Improve carriage/stride when falling down pit

Browse Source
This commit is contained in:
justin
2026-03-27 00:33:19 +00:00
parent fed607681b
commit ac09ed6629
7 changed files with 119 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/HandPos.hs
+8
View File
@@ -45,6 +45,8 @@ rightHandPQ cr
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
Just (Walking sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
Just (Falling sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
Just (Falling sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
_ -> (V3 0 (- off) 10, Q.qID)
where
off = 8
@@ -66,6 +68,8 @@ leftHandPQ cr
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
Just (Walking sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
Just (Falling sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
Just (Falling sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
_ -> (V3 0 off 10, Q.qID)
where
off = 8
@@ -89,6 +93,8 @@ leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
x = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> f sa
Just (Walking sa RightForward) -> - f sa
Just (Falling sa LeftForward) -> f sa
Just (Falling sa RightForward) -> - f sa
_ -> 0
off = 5
sLen = _strideLength $ _crStance cr
@@ -105,6 +111,8 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
x = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> -f sa
Just (Walking sa RightForward) -> f sa
Just (Falling sa LeftForward) -> -f sa
Just (Falling sa RightForward) -> f sa
_ -> 0
off = -5
sLen = _strideLength $ _crStance cr
src/Dodge/Creature/Update.hs
+8 -2
View File
@@ -136,7 +136,7 @@ dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $
chasmTestLiving :: Creature -> World -> World
chasmTestLiving cr w
| _crZVel cr < 0 =
| Falling {} <- cr ^. crStance . carriage =
w
& tocr . crZVel -~ 0.5
& tocr . crPos . _z +~ _crZVel cr
@@ -145,13 +145,19 @@ chasmTestLiving cr w
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
& tocr . crPos . _xy -~ normalizeV (vNormal (x - y))
& chasmRotate cr (x - y)
| any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5
| any f (w ^. cWorld . chasms) = w & tocr %~ startFalling
| otherwise = w
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
f = pointInPoly (cr ^. crPos . _xy)
startFalling :: Creature -> Creature
startFalling cr = case cr ^. crStance . carriage of
Walking a b -> cr & crZVel -~ 0.5
& crStance . carriage .~ Falling a b
_ -> cr
chasmTestCorpse :: Creature -> World -> World
chasmTestCorpse cr w
| _crZVel cr < 0 =
src/Dodge/Data/Creature/Stance.hs
+1
View File
@@ -24,6 +24,7 @@ data Carriage
| Floating
| Flying
| Boosting Point2
| Falling {_fallFlail :: Float, _fallFoot :: FootForward}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data FootForward = LeftForward | RightForward
src/Dodge/Inventory.hs
+5 -1
View File
@@ -20,6 +20,7 @@ module Dodge.Inventory (
collectInvItems,
shiftInvItemsUp,
shiftInvItemsDown,
closeItemDist,
) where
import Control.Monad
@@ -142,9 +143,12 @@ updateCloseObjects w =
x <- lw ^? terminals . ix tid . tmStatus
return (x /= TerminalDeactivated)
_ -> True
isclose x = dist y x < 30 && hasButtonLOS y x w
isclose x = dist y x < closeItemDist && hasButtonLOS y x w
y = you w ^. crPos . _xy
closeItemDist :: Float
closeItemDist = 30
changeSwapSelSet :: Int -> World -> World
changeSwapSelSet yi w
| yi >= 0 = foldl' (&) w $ replicate yi (swapSelSet shiftSetUp)
src/Dodge/TestString.hs
+2 -2
View File
@@ -34,8 +34,8 @@ import Data.Monoid
import RandomHelp
testStringInit :: Universe -> [String]
testStringInit _ = []
-- a (fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . each . crWallTouch)
testStringInit u =
(fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . each . crStance . carriage . strideAmount)
-- a <> fromMaybe [] (do
-- a w1 <- u ^? uvWorld . cWorld . lWorld . walls . ix 18
-- a w2 <- u ^? uvWorld . cWorld . lWorld . walls . ix 61
src/Dodge/Update.hs
+13 -22
View File
@@ -368,10 +368,10 @@ muzzleWallCheck w cr = fromMaybe cr $ do
_ -> Nothing
updateCreatureStrides :: World -> World
updateCreatureStrides w = foldl' updateCreatureStride w $ w ^. cWorld . lWorld . creatures
updateCreatureStrides = cWorld . lWorld . creatures . each %~ updateCreatureStride
updateCreatureStride :: World -> Creature -> World
updateCreatureStride w cr = w & cWorld . lWorld . creatures . ix (cr ^. crID) . crStance . carriage . strideAmount +~ d
updateCreatureStride :: Creature -> Creature
updateCreatureStride cr = cr & crStance . carriage . strideAmount +~ d
where
s = fromMaybe 0 $ crMvType cr ^? mvSpeed
d = min s . norm $ cr ^. crPos - cr ^. crOldPos
@@ -394,7 +394,7 @@ checkTermDist w = fromMaybe w $ do
tmid <- w ^? hud . subInventory . termID
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
guard $ dist btpos (you w ^. crPos . _xy) > 40
guard $ dist btpos (you w ^. crPos . _xy) > closeItemDist
return $ w & hud . subInventory .~ NoSubInventory
updateMouseContext :: Config -> Universe -> Universe
@@ -408,15 +408,9 @@ updateMouseContextGame cfig u = \case
x@OverInvDragSelect{} -> x
MouseGameRotate x
| ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x
--_ -> fromMaybe aimcontext (isrotatedrag <|> overterm <|> overinv <|> overcomb)
_ -> fromMaybe aimcontext (overterm <|> overinv <|> overcomb)
where
w = u ^. uvWorld
-- isrotatedrag = do
-- t1 <- w ^. input . mouseButtons . at ButtonLeft
-- t2 <- w ^. input . mouseButtons . at ButtonRight
-- guard $ t1 > t2
-- return $ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
aimcontext
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| Display_debug `S.member` (cfig ^. debug_booleans) = getDebugMouseOver u
@@ -513,8 +507,7 @@ updatePulseLasers w = f w & cWorld . lWorld . pulseLasers .~ pzs
updatePlasmaBall :: World -> PlasmaBall -> (World, Maybe PlasmaBall)
updatePlasmaBall w pb
| Just (_, ecrwl) <- thit =
( w
& cWorld . lWorld %~ dodam ecrwl
( w & cWorld . lWorld %~ dodam ecrwl
, Nothing
)
| norm (pb ^. pbVel) <= 0 = (w, Nothing)
@@ -576,11 +569,8 @@ updateTerminal tm w = fromMaybe w $ do
return $ case tl of
_ | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
(TLine _ tls g) ->
w & pointTermParams
%~ ( (tmFutureLines %~ tail)
. (tmDisplayedLines %~ take getMaxLinesTM . (map displayTerminalLineString tls ++))
-- . (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
)
w & pointTermParams . tmFutureLines %~ tail
& pointTermParams . tmDisplayedLines %~ take getMaxLinesTM . (map displayTerminalLineString tls ++)
& doTmWdWd g tm
where
pointTermParams = cWorld . lWorld . terminals . ix (_tmID tm)
@@ -976,11 +966,12 @@ crSpring c w =
crsNearCirc (c ^. crPos . _xy) (crRad $ c ^. crType) w
canSpring :: Creature -> Bool
canSpring cr = cr ^. crPos . _z >= 0 && case cr ^. crHP of
HP{} -> True
CrIsCorpse{} -> True
CrIsGibs -> False
CrIsPitted -> False
canSpring cr =
cr ^. crPos . _z >= 0 && case cr ^. crHP of
HP{} -> True
CrIsCorpse{} -> True
CrIsGibs -> False
CrIsPitted -> False
crCrSpring :: Creature -> Creature -> World -> World
crCrSpring c1 c2