Fix bee slime mounting

2026-05-09 17:46:27 +01:00
parent 437ca007ef
commit 72056e5e3e
7 changed files with 173 additions and 187 deletions
@@ -46,7 +46,7 @@ performActions cid w =
        iss
  where
    cr = w ^?! cWorld . lWorld . creatures . ix cid
-    (iss, mayas) = fromMaybe ([],NoAction) $ performAction cr w <$> cr ^? crActionPlan . apAction
+    (iss, mayas) = maybe ([],NoAction) (performAction cr w) (cr ^? crActionPlan . apAction)

 type ActionUpdate = ([Impulse], Action)

@@ -67,10 +67,6 @@ drawSlimeCrit cr =
        guard $ length qs == 12
        return $ zipWith (+) (fmap (0.1 * (10 - x) *^) so) (fmap (0.1 * x *^) qs)

-- assumes d is a unit vector
-scaleAlong :: Point2 -> Float -> Point2 -> Point2
-scaleAlong d s p = ((s - 1) * dot d p) *^ d + p
-
 basicCrPict :: IM.IntMap Item -> Creature -> SPic
 basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)

@@ -122,20 +118,17 @@ drawBeeCrit cr =
    colorSH
        col
        (f . upperPrismPolyHalfMI 3 $ polyCirc 6 r)
-        <> colorSH (dark col) (overPosSH (Q.apply (beakpos)) $ upperPrismPolyHalfST 1 $ [V2 0 (-2), V2 4 0, V2 0 2])
+        <> colorSH (dark col) (overPosSH (Q.apply beakpos) $ upperPrismPolyHalfST 1 [V2 0 (-2), V2 4 0, V2 0 2])
  where
    r = cr ^. crType . to crRad
    beakpos = (V3 (r - 1) 0 0, Q.qid)
-    col
-        | cr ^?! crType . beeAggro > 0 = red
+    col | cr ^?! crType . beeAggro > 0 = red
        | otherwise = yellow
-    f
-        | Mounted{} <- cr ^. crStance . carriage =
-            each . sfVs . each . _xy %~ scaleAlong (V2 0 1) (1 + g (modTo 1 (cr ^?! crType . beeSlime . to ((/ 100) . fromIntegral))))
+    f   | Mounted{} <- cr ^. crStance . carriage =
+            each.sfVs.each._y *~ g (modTo 1 $ cr ^?! crType . beeSlime . to ((/ 100) . fromIntegral))
        | otherwise = id
-    g x
-        | x > 0.5 = 1 - x
-        | otherwise = x
+    g x | x > 0.5 = 2 - x
+        | otherwise = 1 + x

 drawCrabCrit :: World -> Creature -> Shape
 drawCrabCrit w cr =
@@ -70,7 +70,7 @@ hivePainEffect cr w
    | otherwise = w
  where
    (a,g') = randomR (0,2*pi) $ w ^. randGen
-    (b,g) = runState randOnUnitSphere $ g'
+    (b,g) = runState randOnUnitSphere g'
    p = (crRad (cr ^. crType) + 5) *^ unitVectorAtAngle a
    v = 3 *^ b

@@ -57,8 +57,10 @@ updateCarriage' cid cr w = \case
        mcr <- w ^? cWorld . lWorld . creatures . ix mid
        mp <- mcr ^? crPos
        d <- mcr ^? crType . slimeCompression
-        return $ w & tocr . crPos .~ mp + (p & _x *~ d & _y %~ (/d))
+        return $ w & tocr . crPos .~ mp + (oxyrot (mcr ^. crDir) 
+            (oxyrot (-mcr^.crDir) p & _x *~ d & _y %~ (/d)))
  where
+    oxyrot a = over _xy (rotateV a)
    tocr = cWorld . lWorld . creatures . ix cid
    oop = cr ^. crOldOldPos
    f v | norm v > 10 = 10 *^ signorm v
@@ -79,7 +81,6 @@ pushAgainst x y
    | a > 0 = y - project y x
    | otherwise = y
  where
-    -- project y x is the projection of x onto y
    a = dotV (normalize y) (project y x)

 walkCliffPush :: Creature -> [(Point2,Point2)] -> Point2
@@ -69,7 +69,7 @@ updateLivingCreature cr = case cr ^. crType of
    HoverCrit{} -> crUpdate cid . performActions cid . hoverCritHoverSound cr .
            updateHoverCrit cid
    SlinkCrit{} -> slinkCritUpdate cid
-    SlimeCrit{} -> slimeCritUpdate cid
+    SlimeCrit{} -> updateSlimeCrit cid
    BeeCrit{} -> crUpdate cid . performActions cid . updateBeeFromPheremones cr cid . updateBeeCrit cr cid
    HiveCrit{} -> crUpdate cid . performActions cid . updateHiveCrit cr cid
  where
@@ -196,7 +196,9 @@ updateCalmBee cr cid w
    , distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.8*crRad (tcr ^. crType) 
    , Just d <- tcr ^? crType . slimeCompression
        = w
-        & tocr . crStance . carriage .~ Mounted ti (cr ^. crPos - tcr ^. crPos & _x %~ (/d) & _y *~ d)
+        & tocr . crStance . carriage .~ Mounted ti 
+            (oxyrot (tcr^.crDir) 
+                (oxyrot (-tcr^.crDir) (cr ^. crPos - tcr ^. crPos) & _x %~ (/d) & _y *~ d))
        & tocr . crActionPlan . apAction .~ NoAction
    | Just (tcr,_) <- gettarg = w
            & tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
@@ -206,6 +208,7 @@ updateCalmBee cr cid w
        & tocr . crActionPlan . apStrategy . searchTimer %~ (max 0 . subtract 1)
    | otherwise = startsearch
  where
+    oxyrot a = over _xy (rotateV a)
    (sa,gsa) = runState (takeOne [0,1]) (w ^. randGen)
    starthivereturn = fromMaybe w $ do
        hcr <- gethive
@@ -242,8 +245,8 @@ updateCalmBee cr cid w
        r <- tcr ^? crType . slimeSlime . to slimeToRad
        return $ r > 12

-slimeCritUpdate :: Int -> World -> World
-slimeCritUpdate cid w 
+updateSlimeCrit :: Int -> World -> World
+updateSlimeCrit cid w 
    | r < 5 = w & cWorld . lWorld . creatures . at cid .~ Nothing
    | Just hitp <- w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmPos
        , Just hitv <-  w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmVector
@@ -341,9 +344,9 @@ splitSlimeCrit p v cr = do
    r = cr ^?! crType . slimeSlime . to slimeToRad
    cr' = cr & crDamage .~ []
        & crType . slimeSlimeChange .~ 0
-        & crType . slimeSplitTimer .~ Just (10, mempty)
+        & crType . slimeSplitTimer ?~ (10, mempty)
        & crType . slimeIsCompressing .~ False
-        & crType . slimeCompression .~ 1 -- rotateV (argV mvdir) (V2 r1 0)
+        & crType . slimeCompression .~ 1
    (ps,qs) = cutPoly (p-cxy) (p+v-cxy) $ slimeOutline cr & each %~ rotateV (cr ^. crDir)
    
 -- h is the height of the segment, ie r - distance to center
@@ -364,16 +367,10 @@ slinkCritUpdate cid w =
        *~ Q.axisAngle (V3 0 1 0) (pi / 1000)

 hoverCritHoverSound :: Creature -> World -> World
-hoverCritHoverSound cr w = fromMaybe w $ do
-    guard $ d < 100
-    return $
-        soundContinueVol
-            (0.5 * (1 - 0.01 * d))
-            (CrSound cid)
-            cxy
-            buzz1S
-            (Just 2)
-            w
+hoverCritHoverSound cr w
+    | d < 100 
+        = soundContinueVol (0.5 * (1 - 0.01 * d)) (CrSound cid) cxy buzz1S (Just 2) w
+    | otherwise = w
  where
    cxy = cr ^. crPos . _xy
    d = max 0 (dist (you w ^. crPos . _xy) cxy - 100)
@@ -1058,7 +1058,7 @@ crCrSpring c1 c2
 slimeSuck :: Creature -> Creature -> World -> World
 slimeSuck c1 c2 = cWorld . lWorld . creatures %~ (rolap . rolap')
  where
-    suckx = (min 1 $ 2 * (1 - distance xy1 xy2 / (r1 + r2))) ^ (2:: Int)
+    suckx = min 1 (2 * (1 - distance xy1 xy2 / (r1 + r2))) ^ (2:: Int)
    rolap = ix id1 . crPos . _xy +~ f (suckx * 1.5 * m2 / (m1+m2)) *^ normalize (xy2 - xy1)
    rolap' = ix id2 . crPos . _xy +~ f (suckx * 1.5*m1 / (m1+m2)) *^ normalize (xy1 - xy2)
    f = min (distance xy1 xy2/2)