Make falling creatures land on cliff corners

This commit is contained in:
2026-04-05 09:07:31 +01:00
parent b3b1fc6d87
commit 3952b2b1b7
6 changed files with 216 additions and 214 deletions
+3 -11
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.Update (updateCreature) where
import Dodge.WorldEvent.ThingsHit
import Dodge.Base.You
import Control.Monad
import Color
@@ -174,10 +175,7 @@ dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $
chasmTestLiving :: Creature -> World -> World
chasmTestLiving cr w
| Flying {} <- cr ^. crStance . carriage = w
| Falling {} <- cr ^. crStance . carriage =
w
-- & tocr . crZVel -~ 0.5
-- & tocr . crPos . _z +~ _crZVel cr
| Falling {} <- cr ^. crStance . carriage = w
| Just (x, y) <- List.find g (w ^. cWorld . cliffs) =
w
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
@@ -187,7 +185,7 @@ chasmTestLiving cr w
| otherwise = w
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
g = uncurry $ crOnSeg cr
f = pointInPoly (cr ^. crPos . _xy)
startFalling :: Creature -> Creature
@@ -197,16 +195,10 @@ startFalling cr = case cr ^. crStance . carriage of
chasmTestCorpse :: Creature -> World -> World
chasmTestCorpse cr w
-- | _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 %~ startFalling
| otherwise = w
where