Work on bee/slime pincushion

src/Dodge/Creature/State/WalkCycle.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Dodge.Creature.State.WalkCycle (updateCarriage) where
+module Dodge.Creature.State.WalkCycle (updateCarriage
+    ,compressionScale) where
 
 import qualified Quaternion as Q
 import Dodge.Creature.Radius
@@ -51,14 +52,23 @@ updateCarriage' cid cr w = \case
         & chasmTestCliffPush groundCliffPush cr
     Rooted {} -> w
     Mounted mid p -> fromMaybe w $ do
-        mp <- w ^? cWorld . lWorld . creatures . ix mid . crPos
-        return $ w & tocr . crPos .~ mp + p
+        mcr <- w ^? cWorld . lWorld . creatures . ix mid
+        mp <- mcr ^? crPos
+        d <- mcr ^? crType . slimeCompression
+        r <- mcr ^? crType . slimeRad
+        return $ w & tocr . crPos .~ mp + (p & _xy %~ compressionScale ((1/r) *^ d))
   where
     tocr = cWorld . lWorld . creatures . ix cid
     oop = cr ^. crOldOldPos
     f v | norm v > 10 = 10 *^ signorm v
         | otherwise = v
 
+compressionScale :: Point2 -> Point2 -> Point2
+compressionScale d p = dot d p *^ normalize d
+    + (dot d' p / norm d) *^ d'
+  where
+    d' = vNormal $ normalize d
+
 flyInertia :: Creature -> Float
 flyInertia _ = 0.975