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
 

src/Dodge/Creature/Update.hs

@@ -107,9 +107,9 @@ updateBeeCrit cr cid w
     , x >= 0.5
         = w & tocr . crType . beeSlime -~ 0.5
     | Just hcr <- gethive
-    , Just _ <- cr ^? crStance . carriage . mountID
+    , Just mid <- cr ^? crStance . carriage . mountID
     , Just x <- cr ^? crType . beeSlime 
-    , x >= 15
+    , x >= 15 || mountshakeoff mid
         = w & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
             & tocr . crStance . carriage .~ Flying 0
     | Just hcr <- gethive
@@ -120,8 +120,11 @@ updateBeeCrit cr cid w
     ,  Just tcr <- find isslime $ crsNearCirc (cr ^. crPos . _xy) 100 w =
          w & tocr . crActionPlan . apStrategy .~ HarvestFrom (tcr ^. crID)
     | Just (tcr,ti) <- gettarg
-    , distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.5*crRad (tcr ^. crType) = w
-        & tocr . crStance . carriage .~ Mounted ti (cr ^. crPos - tcr ^. crPos)
+    , distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.5*crRad (tcr ^. crType) 
+    , Just r <- tcr ^? crType . slimeRad
+    , Just d <- tcr ^? crType . slimeCompression
+        = w
+        & tocr . crStance . carriage .~ Mounted ti (cr ^. crPos - tcr ^. crPos & _xy %~ compressionScale (vNormal ((1/r) *^d)))
     | Just tid <- cr ^? crStance . carriage . mountID
     , Just SlimeCrit{} <- w ^? cWorld . lWorld . creatures . ix tid . crType = w
         & tocr . crType . beeSlime +~ sspeed
@@ -130,7 +133,11 @@ updateBeeCrit cr cid w
             & tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
     | otherwise = w & tocr . crActionPlan . apStrategy .~ Search
   where
-    sspeed = 0.1
+    mountshakeoff mid = fromMaybe True $ do
+        mcr <- w ^? cWorld . lWorld . creatures . ix mid
+        SlimeCrit {_slimeSplitTimer = x} <- mcr ^? crType
+        return $ x > 0
+    sspeed = 0.05
     gettarg = do
         i <- cr ^? crActionPlan . apStrategy . harvestTarget 
         tcr <-  w ^? cWorld . lWorld . creatures . ix i