Make creatures rotate when falling down chasms

src/Dodge/Creature/State/WalkCycle.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Creature.State.WalkCycle (updateCarriage) where
 
+import qualified Quaternion as Q
 import Dodge.Creature.Radius
 import Geometry
 import Dodge.Update.Camera.Rotate
@@ -32,7 +33,7 @@ updateCarriage' cid cr w = \case
             & tocr . crStance . carriage . zSpeed 
                 %~ if cr ^. crPos . _z < 17 then min 0.05 . (+0.001) else max (-0.05) . subtract 0.001
     Boosting {} -> w
-    Falling {} -> 
+    Falling {_fallRot = q} -> 
         let v = 0.95 *^ (cr ^. crOldPos - oop & _z -~ 0.5)
             ep = cr ^. crPos + v
         in if ep ^. _z < 0 && cr ^. crOldPos . _z >= 0 &&
@@ -41,6 +42,8 @@ updateCarriage' cid cr w = \case
             then w & tocr . crPos .~ (ep & _z .~ 0)
                     & cWorld . lWorld . creatures . ix cid . crStance . carriage .~ OnGround
             else w & cWorld . lWorld . creatures . ix cid . crPos .~ ep
+                    & cWorld . lWorld . creatures . ix cid . crStance . carriage . fallDir *~ q
+                        
     OnGround {} -> w
         & tocr . crPos . _xy +~ 0.8 *^ (cr ^. crOldPos . _xy - oop ^. _xy)
         & chasmTestCliffPush groundCliffPush cr
@@ -106,7 +109,10 @@ chasmTestCliffPush f' cr w
             & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
             & tocr . crPos . _xy +~ f' cr (xy:xys) -- (f cr (xy:xys)) *^ h xy xys
             & chasmRotate cr (uncurry (-) xy)
-    | any f (w ^. cWorld . chasms) = w & tocr . crStance . carriage .~ Falling -- %~ startFalling
+    | any f (w ^. cWorld . chasms) = w & tocr . crStance . carriage 
+        .~ Falling 
+            (Q.axisAngle (0 & _xy .~ vNormal (cr^.crOldOldPos._xy - cr^.crOldPos._xy)) 0.03) 
+            Q.qid
     | otherwise = w
   where
     cxy = cr ^. crPos . _xy

src/Dodge/Creature/Update.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.Update (updateCreature) where
 
+import qualified Quaternion as Q
 import Dodge.Creature.Picture
 import Dodge.Base.You
 import Control.Monad
@@ -127,9 +128,9 @@ startDeathTimer cr = cr
 
 toDeathCarriage :: Carriage -> Carriage
 toDeathCarriage = \case
-    Flying {} -> Falling
+    Flying {} -> Falling Q.qid Q.qid
     Walking -> OnGround
-    _ -> Falling
+    _ -> Falling Q.qid Q.qid
 
 -- could look at the amount of damage here (given by maxDamage) too
 corpseOrGib :: Creature -> World -> World

src/Dodge/Data/Creature/Stance.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -11,6 +12,7 @@ import Data.Aeson
 import Data.Aeson.TH
 import Dodge.Data.AimStance
 import Geometry.Data
+import Linear
 
 data Stance = Stance
     { _carriage :: Carriage
@@ -23,7 +25,7 @@ data Carriage
     | Floating
     | Flying {_zSpeed :: Float, _flyInertia :: Float}
     | Boosting Point2
-    | Falling 
+    | Falling {_fallRot :: Quaternion Float, _fallDir :: Quaternion Float}
     | OnGround
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
@@ -36,6 +38,7 @@ data Posture = Aiming | AtEase
 makeLenses ''Stance
 makeLenses ''Carriage
 makeLenses ''Posture
+deriveJSON defaultOptions ''Quaternion
 deriveJSON defaultOptions ''FootForward
 deriveJSON defaultOptions ''Posture
 deriveJSON defaultOptions ''Carriage

src/Dodge/Render/ShapePicture.hs

@@ -1,6 +1,7 @@
 --{-# LANGUAGE LambdaCase #-}
 module Dodge.Render.ShapePicture (worldSPic) where
 
+import qualified Quaternion as Q
 import Dodge.Debug
 import Control.Lens
 import Data.Foldable
@@ -109,7 +110,7 @@ drawPlasmaBall pb =
         $ circleSolidCol green white 5
 
 drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
-drawCreature w m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $
+drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
     case cr ^. crType of
         _ | CrIsCorpse sp <- cr ^. crHP -> sp
         _ | null (cr ^? crHP . _HP) -> mempty
@@ -121,6 +122,10 @@ drawCreature w m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $
         AutoCrit -> basicCrPict m cr
         CrabCrit {} -> noPic $ drawCrabCrit w cr
         HoverCrit{} -> noPic $ drawHoverCrit cr
+  where
+    fallrot = case cr ^. crStance . carriage of
+        Falling {_fallDir = q} -> _1 . each . sfVs . each %~ Q.rotate q
+        _ -> id
 
 barrelShape :: SPic
 barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)