justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add bee crits

Browse Source
This commit is contained in:
justin
2026-04-20 12:25:39 +01:00
parent 722a25240e
commit adae6b84f4
20 changed files with 340 additions and 184 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+2
View File
@@ -193,6 +193,8 @@ crHeight cr = case cr ^. crHP of
CrabCrit {} -> 25
SlinkCrit {} -> 25
SlimeCrit {_slimeRad = r} -> r
BeeCrit {} -> 10
HiveCrit {} -> 25
_ -> error "Need to define crHeight for this crType"
CrIsCorpse{} -> Just 5
CrDestroyed{} -> Nothing
src/Dodge/Creature/ChaseCrit.hs
+21 -1
View File
@@ -6,6 +6,8 @@ module Dodge.Creature.ChaseCrit (
hoverCrit,
slinkCrit,
slimeCrit,
beeCrit,
hiveCrit,
) where
import qualified Quaternion as Q
@@ -82,4 +84,22 @@ hoverCrit =
& crHP .~ HP 150
& crType .~ HoverCrit 0
& crFaction .~ ColorFaction blue
& crStance . carriage .~ Flying 15 0.975
& crStance . carriage .~ Flying 15
beeCrit :: Creature
beeCrit =
defaultCreature
& crName .~ "beeCrit"
& crHP .~ HP 100
& crType .~ BeeCrit 0 Nothing
& crFaction .~ ColorFaction yellow
& crStance . carriage .~ Flying 15
hiveCrit :: Creature
hiveCrit =
defaultCreature
& crName .~ "hiveCrit"
& crHP .~ HP 100000
& crType .~ HiveCrit [] 0
& crStance . carriage .~ Rooted
& crFaction .~ ColorFaction yellow
src/Dodge/Creature/Mass.hs
+2
View File
@@ -14,3 +14,5 @@ crMass = \case
SlinkCrit{} -> 100
LampCrit {} -> 3
SlimeCrit {_slimeRad = r} -> r * r / 10
BeeCrit {_beeSlime = x} -> 3 + x
HiveCrit {} -> 100
src/Dodge/Creature/Material.hs
+2
View File
@@ -17,3 +17,5 @@ crMaterial = \case
BarrelCrit{} -> Metal
LampCrit{} -> Glass
SlimeCrit{} -> Flesh
BeeCrit{} -> Flesh
HiveCrit{} -> Flesh
src/Dodge/Creature/MaxHP.hs
+2
View File
@@ -15,3 +15,5 @@ crMaxHP = \case
LampCrit {} -> 50
SlinkCrit {} -> 1000
SlimeCrit {} -> 1000
BeeCrit {} -> 100
HiveCrit {} -> 10000
src/Dodge/Creature/MoveType.hs
+2
View File
@@ -17,6 +17,8 @@ crMvType cr = case _crType cr of
BarrelCrit {} -> defaultAimMvType
LampCrit {} -> defaultAimMvType
SlimeCrit {} -> NoMvType
BeeCrit {} -> defaultChaseMvType & mvSpeed .~ 0.1
HiveCrit{} -> NoMvType
defaultAimMvType :: CrMvType
defaultAimMvType =
src/Dodge/Creature/Picture.hs
+15
View File
@@ -48,6 +48,8 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
HoverCrit{} -> noPic $ drawHoverCrit cr
SlinkCrit{} -> noPic $ drawSlinkCrit cr
SlimeCrit{} -> noPic $ drawSlimeCrit cr
BeeCrit{_beeSlime=x} -> noPic $ drawBeeCrit x
HiveCrit{} -> drawHive
where
fallrot = case cr ^? crStance . carriage . carDir of
Just q -> _1 . each . sfVs . each %~ Q.rotate q
@@ -114,6 +116,18 @@ drawHoverCrit cr = colorSH (_skinHead cskin)
f a = tpq `Q.comp` (1 & _xy .~ rotateV a 5, Q.qid)
tpq = (V3 0 0 0, Q.qid)
drawHive :: SPic
drawHive = noPic $ upperPrismPolyHalfMI 25 $ polyCirc 6 20
drawBeeCrit :: Float -> Shape
drawBeeCrit x = colorSH yellow
(upperPrismPolyHalfMI 3 $ polyCirc 6 r)
<>
colorSH (dark yellow) (overPosSH (Q.apply (beakpos)) $ upperPrismPolyHalfST 1 $ [V2 0 (-2), V2 4 0,V2 0 2])
where
r = sqrt $ 2 ^(2::Int) + x
beakpos = (V3 (r-1) 0 0, Q.qid)
drawCrabCrit :: World -> Creature -> Shape
drawCrabCrit w cr = mconcat
[ crabUpperBody w cr
@@ -264,6 +278,7 @@ makeCorpse g cr = case cr ^. crType of
HoverCrit{} -> noPic $ drawHoverCrit cr
ChaseCrit{} -> noPic $ chaseCorpse g cr
CrabCrit{} -> noPic $ crabCorpse g cr
BeeCrit{} -> noPic $ drawBeeCrit 0
_ ->
noPic
. scaleSH (V3 crsize crsize crsize)
src/Dodge/Creature/Radius.hs
+2
View File
@@ -11,9 +11,11 @@ crRad = \case
ChaseCrit {} -> 10
CrabCrit {} -> 10
HoverCrit {} -> 8
BeeCrit {_beeSlime = x} -> sqrt $ 2^(2::Int) + x
SwarmCrit -> 2
AutoCrit -> 10
BarrelCrit{} -> 10
LampCrit {} -> 3
SlinkCrit {} -> 10
HiveCrit {} -> 20
SlimeCrit {_slimeRad = r,_slimeRadWobble = x} -> r - x
src/Dodge/Creature/Shape.hs
+3 -1
View File
@@ -15,5 +15,7 @@ crShape = \case
AutoCrit -> Humanoid (greyN 0.9) (lightx4 red) (greyN 0.3)
SlinkCrit{} -> Humanoid (greyN 0.9) (dark . dark . dark $ orange) (greyN 0.3)
BarrelCrit {} -> Barreloid
LampCrit {} -> NonDrawnCreature
LampCrit {} -> NoCreatureShape
SlimeCrit {} -> Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3)
BeeCrit {} -> NoCreatureShape
HiveCrit {} -> NoCreatureShape
src/Dodge/Creature/State/WalkCycle.hs
+9 -1
View File
@@ -28,7 +28,8 @@ updateCarriage' cid cr w = \case
& chasmTestCliffPush walkCliffPush cr
Crawling -> w & chasmTestCliffPush walkCliffPush cr
Floating -> w
Flying {_zSpeed = dz, _flyInertia = x} ->
Flying {_zSpeed = dz} -> let x = flyInertia cr
in
w & tocr . crPos . _xy +~ x *^ f (cr ^. crOldPos . _xy - oop ^. _xy)
& tocr . crPos . _z +~ dz
& tocr . crStance . carriage . zSpeed
@@ -48,12 +49,19 @@ updateCarriage' cid cr w = \case
OnGround {} -> w
& tocr . crPos . _xy +~ 0.8 *^ (cr ^. crOldPos . _xy - oop ^. _xy)
& 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
where
tocr = cWorld . lWorld . creatures . ix cid
oop = cr ^. crOldOldPos
f v | norm v > 10 = 10 *^ signorm v
| otherwise = v
flyInertia :: Creature -> Float
flyInertia _ = 0.975
pushAgainst :: Point2 -> Point2 -> Point2
pushAgainst x y
| a > norm y = 0
src/Dodge/Creature/Statistics.hs
+14 -13
View File
@@ -3,7 +3,7 @@ module Dodge.Creature.Statistics (
getCrMoveSpeed,
crStrength,
crDexterity,
crIntelligence,
-- crIntelligence,
) where
import Dodge.Data.Equipment.Misc
@@ -38,18 +38,19 @@ crStrength cr = case cr ^. crType of
LampCrit {} -> 0
_ -> 46
crIntelligence :: Creature -> Int
crIntelligence cr = case cr ^. crType of
Avatar { _avIntelligence = x } -> x
ChaseCrit {} -> 20
CrabCrit {} -> 20
HoverCrit {} -> 20
SwarmCrit -> 20
AutoCrit -> 20
BarrelCrit {} -> 0
LampCrit {} -> 0
SlinkCrit{} -> 5
SlimeCrit{} -> 1
--crIntelligence :: Creature -> Int
--crIntelligence cr = case cr ^. crType of
-- Avatar { _avIntelligence = x } -> x
-- ChaseCrit {} -> 20
-- CrabCrit {} -> 20
-- HoverCrit {} -> 20
-- SwarmCrit -> 20
-- AutoCrit -> 20
-- BarrelCrit {} -> 0
-- LampCrit {} -> 0
-- SlinkCrit{} -> 5
-- SlimeCrit{} -> 1
-- BeeCrit{} -> 20
getCrMoveSpeed :: LWorld -> Creature -> Int
src/Dodge/Creature/Update.hs
+68 -5
View File
@@ -3,6 +3,9 @@
module Dodge.Creature.Update (updateCreature) where
--import Dodge.WorldEvent.ThingsHit
import Dodge.Creature.Radius
import Dodge.Zoning.Creature
import Dodge.Creature.ChaseCrit
import Dodge.Creature.Damage
import Color
import Control.Monad
@@ -52,7 +55,7 @@ damageCorpse :: Int -> Creature -> World -> World
damageCorpse _ cr w = w & applyCreatureDamage (cr ^. crDamage) cr
updateLivingCreature :: Creature -> World -> World
updateLivingCreature cr = case _crType cr of
updateLivingCreature cr = case cr ^. crType of
Avatar{} ->
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
. crUpdate cid
@@ -71,9 +74,72 @@ updateLivingCreature cr = case _crType cr of
over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
SlinkCrit{} -> slinkCritUpdate cid
SlimeCrit{} -> slimeCritUpdate cid
BeeCrit{} -> crUpdate cid . performActions cid . updateBeeCrit cr cid
HiveCrit{} -> crUpdate cid . performActions cid . updateHiveCrit cr cid
where
cid = cr ^. crID
updateHiveCrit :: Creature -> Int -> World -> World
updateHiveCrit cr cid w
| Just x <- cr ^? crType . hiveChildren . to length
, x < 10
, Just y <- cr ^? crType . hiveGestation
, y == 0 = w
& tocr . crType . hiveChildren .:~ nid
& tocr . crType . hiveGestation .~ 50
& cWorld . lWorld . creatures . at nid ?~ ncr
| Just x <- cr ^? crType . hiveChildren . to length
, x < 10 = w
& tocr . crType . hiveGestation %~ (max 0 . subtract 1)
| otherwise = w
where
tocr = cWorld . lWorld . creatures . ix cid
nid = IM.newKey $ w ^. cWorld . lWorld . creatures
ncr = beeCrit & crPos .~ (cr ^. crPos + (0 & _xy +~ 25))
& crID .~ nid
& crType . beeHive ?~ cid
updateBeeCrit :: Creature -> Int -> World -> World
updateBeeCrit cr cid w
| Just hcr <- gethive
, distance (cr ^. crPos . _xy) (hcr ^. crPos . _xy) < 30
, Just x <- cr ^? crType . beeSlime
, x >= 0.5
= w & tocr . crType . beeSlime -~ 0.5
| Just hcr <- gethive
, Just _ <- cr ^? crStance . carriage . mountID
, Just x <- cr ^? crType . beeSlime
, x >= 15
= w & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
& tocr . crStance . carriage .~ Flying 1
| Nothing <- cr ^? crActionPlan . apStrategy . harvestTarget
, 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)
| Just tid <- cr ^? crStance . carriage . mountID
, Just SlimeCrit{} <- w ^? cWorld . lWorld . creatures . ix tid . crType = w
& tocr . crType . beeSlime +~ 0.5
& cWorld . lWorld . creatures . ix tid . crType . slimeRad %~ (sqrt . subtract 0.5 . (^(2::Int)))
| Just (tcr,_) <- gettarg = w
& tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
| otherwise = w & tocr . crActionPlan . apStrategy .~ Search
where
gettarg = do
i <- cr ^? crActionPlan . apStrategy . harvestTarget
tcr <- w ^? cWorld . lWorld . creatures . ix i
x <- tcr ^? crType . slimeRad
guard $ x > 12
return (tcr,i)
gethive = do
i <- cr ^? crType . beeHive . _Just
w ^? cWorld . lWorld . creatures . ix i
tocr = cWorld . lWorld . creatures . ix cid
isslime tcr = case tcr ^. crType of
SlimeCrit {} -> True
_ -> False
slimeCritUpdate :: Int -> World -> World
slimeCritUpdate cid w
| r < 5 = w & cWorld . lWorld . creatures . ix cid . crHP .~ CrDestroyed Gibbed
@@ -251,10 +317,7 @@ checkDeath' cr w = case cr ^. crHP of
tocr = cWorld . lWorld . creatures . ix (_crID cr)
startDeathTimer :: Creature -> Creature
startDeathTimer cr =
cr
& crDeathTimer
?~ case cr ^. crType of
startDeathTimer cr = cr & crDeathTimer ?~ case cr ^. crType of
HoverCrit{} -> 0
_ -> 5
src/Dodge/Creature/Vocalization.hs
+4
View File
@@ -34,6 +34,8 @@ crWarningSounds cr = case cr ^. crType of
AutoCrit -> mempty
BarrelCrit{} -> mempty
LampCrit{} -> mempty
BeeCrit{} -> mempty
HiveCrit{} -> mempty
crDeathSounds :: Creature -> DeathType -> [SoundID]
crDeathSounds cr dt = case cr ^. crType of
@@ -47,6 +49,8 @@ crDeathSounds cr dt = case cr ^. crType of
AutoCrit -> mempty
BarrelCrit{} -> mempty
LampCrit{} -> mempty
BeeCrit{} -> defaultDeathSounds dt
HiveCrit{} -> defaultDeathSounds dt
defaultDeathSounds :: DeathType -> [SoundID]
defaultDeathSounds = \case
src/Dodge/Data/ActionPlan.hs
+1
View File
@@ -150,6 +150,7 @@ data Strategy
| Flee
-- | MeleeStrike
| Search
| HarvestFrom {_harvestTarget :: Int}
deriving (Eq, Ord, Show) --Generic, Flat)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/Data/Creature/Misc.hs
+9 -1
View File
@@ -79,6 +79,14 @@ data CreatureType
, _slimeIsCompressing :: Bool
, _slimeFeedProgress :: Float
}
| BeeCrit
{ _beeSlime :: Float
, _beeHive :: Maybe Int
}
| HiveCrit
{ _hiveChildren :: [Int]
, _hiveGestation :: Int
}
| SwarmCrit
| AutoCrit
| BarrelCrit {_barrelType :: BarrelType}
@@ -93,7 +101,7 @@ data CreatureShape
, _skinLower :: Color
}
| Barreloid
| NonDrawnCreature
| NoCreatureShape
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data BarrelType
src/Dodge/Data/Creature/Stance.hs
+3 -1
View File
@@ -24,10 +24,12 @@ data Carriage
= Walking
| Crawling
| Floating
| Flying {_zSpeed :: Float, _flyInertia :: Float}
| Flying {_zSpeed :: Float}--, _flyInertia :: Float}
| Boosting Point2
| Falling {_fallRot :: Quaternion Float, _carDir :: Quaternion Float}
| OnGround {_carDir :: Quaternion Float}
| Rooted
| Mounted {_mountID :: Int, _mountPos :: Point3}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data FootForward = LeftForward | RightForward
src/Dodge/Room/Tutorial.hs
+2 -2
View File
@@ -60,8 +60,8 @@ tutAnoTree = do
--, tToBTree "" . return . cleatOnward <$> (xChasm 200 200
, tToBTree "" . return . cleatOnward <$> ((putSingleLight =<< roomRectAutoLights 300 300)
<&> rmPmnts <>~ [sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 150 100
, sps0 (PutCrit chaseCrit) & plSpot . psPos .~ V2 250 100
, sps0 (PutCrit hoverCrit) & plSpot . psPos .~ V2 250 50
-- , sps0 (PutCrit beeCrit) & plSpot . psPos .~ V2 250 100
, sps0 (PutCrit hiveCrit) & plSpot . psPos .~ V2 250 50
]
)
-- , tToBTree "" . return . cleatOnward <$> (cChasm
src/Dodge/TestString.hs
+10 -10
View File
@@ -42,16 +42,16 @@ tocrs :: (IM.IntMap Creature
tocrs = uvWorld . cWorld . lWorld . creatures
testStringInit :: Universe -> [String]
testStringInit u = u ^.. tocrs . ix 1 . crPos . _xy . to show
<> u ^.. tocrs . ix 1 . crType . slimeCompression . to show
<> u ^.. tocrs . ix 1 . crType . slimeCompression . to norm . to show
<> u ^.. tocrs . ix 1 . crType . to crRad . to show
<> u ^.. tocrs . ix 1 . crType . slimeRad . to show
<> u ^.. tocrs . ix 1 . crType . slimeRadWobble . to show
<> u ^.. tocrs . ix 1 . crType . slimeIsCompressing . to show
<> u ^.. tocrs . ix 1 . crDir . to show
<> u ^.. tocrs . ix 1 . crDamage . to show
-- <> u ^.. tocrs . each . crID . to show
testStringInit u = u ^.. tocrs . ix 2 . crType . hiveChildren . to show
-- u ^.. tocrs . ix 1 . crPos . _xy . to show
-- <> u ^.. tocrs . ix 1 . crType . slimeCompression . to show
-- <> u ^.. tocrs . ix 1 . crType . slimeCompression . to norm . to show
-- <> u ^.. tocrs . ix 1 . crType . to crRad . to show
-- <> u ^.. tocrs . ix 1 . crType . slimeRad . to show
-- <> u ^.. tocrs . ix 1 . crType . slimeRadWobble . to show
-- <> u ^.. tocrs . ix 1 . crType . slimeIsCompressing . to show
-- <> u ^.. tocrs . ix 1 . crDir . to show
-- <> u ^.. tocrs . ix 1 . crDamage . to show
-- where
-- tocr = uvWorld . cWorld . lWorld . creatures . ix 0
-- f = fromMaybe 0
src/Dodge/Update.hs
+5 -2
View File
@@ -1037,8 +1037,11 @@ crCrSpring c1 c2
r1 = crRad (c1 ^. crType)
r2 = crRad (c2 ^. crType)
comRad = crRad (c1 ^. crType) + crRad (c2 ^. crType)
overlap c = ((comRad - diff) * crMass (_crType c) * 0.5 / massT) *^ signorm vec
massT = crMass (_crType c1) + crMass (_crType c2)
overlap c = ((comRad - diff) * cmass c * 0.5 / massT) *^ signorm vec
massT = cmass c1 + cmass c2
cmass c = case c ^. crStance . carriage of
Falling {} -> crMass (c ^. crType) * 10
_ -> crMass (c ^. crType)
slimeSuck :: Creature -> Creature -> World -> World
slimeSuck c1 c2 = cWorld . lWorld . creatures %~ (rolap . rolap')