From f4c59612ea3c9ca257fa892d80cb42317d7044a3 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 26 Apr 2026 09:14:55 +0100 Subject: [PATCH] Improve bee pheremones --- src/Dodge/Creature/State.hs | 39 ++++++++++++++++++++++++++++-------- src/Dodge/Creature/Update.hs | 5 +++-- src/Dodge/Data/Cloud.hs | 3 ++- src/Dodge/Update.hs | 12 ++++------- src/Shader/Poke/Cloud.hs | 2 +- 5 files changed, 41 insertions(+), 20 deletions(-) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index fdb599942..f7f7ad6d2 100644 --- a/src/Dodge/Creature/State.hs +++ b/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 diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index 98f01413b..31204e55c 100644 --- a/src/Dodge/Creature/Update.hs +++ b/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 diff --git a/src/Dodge/Data/Cloud.hs b/src/Dodge/Data/Cloud.hs index eaa36a0f1..6ad718d95 100644 --- a/src/Dodge/Data/Cloud.hs +++ b/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 } diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 76b17af7d..7ef0f3d18 100644 --- a/src/Dodge/Update.hs +++ b/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 diff --git a/src/Shader/Poke/Cloud.hs b/src/Shader/Poke/Cloud.hs index c38068b3c..bcc94b912 100644 --- a/src/Shader/Poke/Cloud.hs +++ b/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)