Make falling creatures land on cliff corners

src/Dodge/Creature/Perception.hs

@@ -62,9 +62,9 @@ basicAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
 crImpulsesOnCognizant :: World -> Creature -> [[Impulse]]
 crImpulsesOnCognizant w cr = case cr ^. crType of
     ChaseCrit {} | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 3] 
-        ++ [[ChangeStrategy $ CloseToMelee 0]]
-    HoverCrit {} | Just sid <- cognizantVoc w cr -> [[Bark sid]]
-         ++ [[ChangeStrategy $ CloseToMelee 0]]
+        <> [[ChangeStrategy $ CloseToMelee 0]]
+    HoverCrit {} | Just sid <- cognizantVoc w cr -> [Bark sid]:
+          [[ChangeStrategy $ CloseToMelee 0]]
     _ | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 1]
     _ -> replicate 5 [RandomImpulse $ RandImpulseCircMove 3]
 

src/Dodge/Creature/State/WalkCycle.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Creature.State.WalkCycle (updateCarriage) where
 
+import Dodge.WorldEvent.ThingsHit
 import Geometry.Polygon
 import Data.Maybe
 import Dodge.Creature.HandPos
@@ -38,7 +39,9 @@ updateCarriage' cid cr w = \case
     Falling {} -> 
         let v = 0.95 *^ (cr ^. crOldPos - oop & _z -~ 0.5)
             ep = cr ^. crPos + v
-        in if ep ^. _z < 0 && not (any (pointInPoly (ep ^. _xy)) (w ^. cWorld . chasms))
+        in if ep ^. _z < 0 && 
+                (not (any (pointInPoly (ep ^. _xy)) (w ^. cWorld . chasms))
+                    || any (uncurry $ crOnSeg cr) (w ^. cWorld . cliffs))
             then w & tocr . crPos .~ (ep & _z .~ 0)
                     & cWorld . lWorld . creatures . ix cid . crStance . carriage .~ OnGround
             else w & cWorld . lWorld . creatures . ix cid . crPos .~ ep

src/Dodge/Creature/Update.hs

@@ -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

src/Dodge/Update.hs

@@ -991,7 +991,7 @@ crCrSpring c1 c2
     diffheight = fromMaybe True $ do
         h1 <- h c1
         h2 <- h c2
-        return $ (z c1 > h2 || z c2 > h1)
+        return $ z c1 > h2 || z c2 > h1
     olap a b = ix (a ^. crID) . crPos . _xy +~ overlap b
     olap' a b = ix (a ^. crID) . crPos . _xy -~ overlap b
     id1 = _crID c1

src/Dodge/WorldEvent/ThingsHit.hs

@@ -18,6 +18,7 @@ module Dodge.WorldEvent.ThingsHit (
     wlsHitUnsorted,
     isWalkable,
     isFlyable,
+    crOnSeg,
 ) where
 
 import ListHelp
@@ -201,3 +202,7 @@ isWalkable :: Point2 -> Point2 -> World -> Bool
 isWalkable p1 p2 w = isFlyable p1 p2 w && not (any f (w ^. cWorld . cliffs))
   where
     f = isJust . uncurry (intersectSegSeg p1 p2)
+
+crOnSeg :: Creature -> Point2 -> Point2 -> Bool
+{-# INLINE crOnSeg #-}
+crOnSeg cr = circOnSeg (cr ^. crPos . _xy) (cr ^. crType . to crRad)