Improve bee pheremones

src/Dodge/Creature/State.hs

@@ -4,6 +4,7 @@ module Dodge.Creature.State (
     invItemEffs,
 ) where
 
+import Dodge.Creature.Radius
 import qualified Data.IntMap.Strict as IM
 import Linear
 import NewInt
@@ -43,16 +44,38 @@ import qualified SDL
 doDamage :: Int -> World -> World
 doDamage cid w = fromMaybe w $ do
     cr <- w ^? cWorld . lWorld . creatures . ix cid
-    return $ applyPastDamages cr $ applyCreatureDamage (cr ^. crDamage) cr w
+    return $ crPainEffect cr $ applyCreatureDamage (cr ^. crDamage) cr w
 
 -- TODO generalise shake to arbitrary damage amounts
-applyPastDamages :: Creature -> World -> World
-applyPastDamages cr w
-    | HoverCrit {} <- cr ^. crType 
-    , _crPain cr > 50 = w
-                & cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ 50
-                & cWorld . lWorld . creatures . ix (_crID cr) . crPos . _z %~ max 12 . subtract 1
-    | HoverCrit {} <- cr ^. crType  = w
+crPainEffect :: Creature -> World -> World
+crPainEffect cr = case cr ^. crType of
+    HoverCrit {} -> hoverPainEffect cr
+    HiveCrit{} -> hivePainEffect cr
+    _ -> jitterPain cr
+
+
+hoverPainEffect :: Creature -> World -> World
+hoverPainEffect cr
+    | _crPain cr > 50 =
+                (cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ 50)
+                . (cWorld . lWorld . creatures . ix (_crID cr) . crPos . _z %~ max 12 . subtract 1)
+    | otherwise = id
+
+
+hivePainEffect :: Creature -> World -> World
+hivePainEffect cr w
+    | _crPain cr > 0 = w & cWorld . lWorld . creatures . ix (cr ^. crID) . crPain %~ (max 0 . subtract 5)
+        & cWorld . lWorld . beePheremones .:~ BPheremone (cr ^. crPos & _xy +~ p & _z .~ 20) v 200
+        & randGen .~ g
+    | otherwise = w
+  where
+    (a,g') = randomR (0,2*pi) $ w ^. randGen
+    (b,g) = runState randOnUnitSphere $ g'
+    p = (crRad (cr ^. crType) + 5) *^ unitVectorAtAngle a
+    v = 3 *^ b
+
+jitterPain :: Creature -> World -> World
+jitterPain cr w
     | _crPain cr > 200 = dojitter 3 100
     | _crPain cr > 20 = dojitter 2 10
     | _crPain cr > 0 = dojitter 1 1

src/Dodge/Creature/Update.hs

@@ -108,7 +108,7 @@ updateBeeFromPheremones cr cid w
     | any f (w ^. cWorld . lWorld . beePheremones) = w & cWorld . lWorld . creatures . ix cid . crType . beeAggro .~ 300
     | otherwise = w
   where
-    f bp = distance (cr ^. crPos . _xy) (bp ^. bpPos) < 20
+    f bp = distance (cr ^. crPos . _xy) (bp ^. bpPos . _xy) < 20
 
 updateBeeCrit :: Creature -> Int -> World -> World
 updateBeeCrit cr
@@ -371,11 +371,12 @@ crDeathEffects cr w = case cr ^. crType of
         return $ w & cWorld . lWorld . creatures . ix hid . crType . hiveChildren %~ IS.delete (cr ^. crID)
     _ -> w
   where
-    beepheremone = cWorld . lWorld . beePheremones .:~ BPheremone (cr ^. crPos . _xy) 200
+    beepheremone = cWorld . lWorld . beePheremones .:~ BPheremone (cr ^. crPos) (cr ^. crPos - cr ^. crOldPos) 200
 
 startDeathTimer :: Creature -> Creature
 startDeathTimer cr = cr & crDeathTimer ?~ case cr ^. crType of
             HoverCrit{} -> 0
+            BeeCrit{} -> 0
             _ -> 5
 
 toDeathCarriage :: Carriage -> Carriage

src/Dodge/Data/Cloud.hs

@@ -45,7 +45,8 @@ data GasType = PoisonGas
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data BeePheremone = BPheremone
-    { _bpPos :: Point2
+    { _bpPos :: Point3
+    , _bpVel :: Point3
     , _bpTimer :: Int
     }
 

src/Dodge/Update.hs

@@ -316,8 +316,8 @@ functionalUpdate =
             (updateIMl' (_linearShockwaves . _lWorld . _cWorld) updateLinearShockwave)
         . over uvWorld (updateIMl' (_projectiles . _lWorld . _cWorld) updateProjectile)
         . over uvWorld updateClouds
-        . over uvWorld updateBeePheremones
-        . over uvWorld updateGasses
+        . over uvWorld (updateObjMapMaybe beePheremones updateBeePheremone)
+        . over uvWorld (updateObjCatMaybes gasses updateGas)
         . over uvWorld updateDusts
         . over uvWorld updateGusts
         . over uvWorld (updateIMl' (_terminals . _lWorld . _cWorld) updateTerminal)
@@ -780,17 +780,13 @@ updateSparks = updateObjCatMaybes sparks updateSpark
 updateClouds :: World -> World
 updateClouds w = updateObjMapMaybe clouds (updateCloud w) w
 
-updateBeePheremones :: World -> World
-updateBeePheremones w = updateObjMapMaybe beePheremones updateBeePheremone w
-
 updateBeePheremone :: BeePheremone -> Maybe BeePheremone
 updateBeePheremone bp 
     | x <- bp ^. bpTimer
     , x <= 0 = Nothing
     | otherwise = Just $ bp & bpTimer -~ 1
-
-updateGasses :: World -> World
-updateGasses = updateObjCatMaybes gasses updateGas
+        & bpVel *~ 0.95
+        & bpPos +~ (bp ^. bpVel)
 
 updateDusts :: World -> World
 updateDusts w = updateObjMapMaybe dusts (updateDust w) w

src/Shader/Poke/Cloud.hs

@@ -24,7 +24,7 @@ pokeBeePheremone :: Ptr Float -> Int -> BeePheremone -> IO Int
 pokeBeePheremone vptr nv = pokeCloudLike vptr nv . mkBeePheremoneCloudLike
 
 mkBeePheremoneCloudLike :: BeePheremone -> (Point3, Point4)
-mkBeePheremoneCloudLike x = (20 & _xy .~ (x ^. bpPos), V4 1 1 0 a)
+mkBeePheremoneCloudLike x = (x ^. bpPos, V4 1 1 0 a)
   where
     a = 0.8 * min 1 (fromIntegral (_bpTimer x) / 100)