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

Work on bee movement

Browse Source
This commit is contained in:
justin
2026-04-23 09:09:16 +01:00
parent b5bfd365b9
commit f6e257464d
12 changed files with 244 additions and 197 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
-1
View File
@@ -93,7 +93,6 @@ startCr =
& crHP .~ HP 10000
& crInv .~ mempty
& crFaction .~ PlayerFaction
-- & crMvType .~ MvWalking yourDefaultSpeed
& crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 AvPosture LeftForward 0
-- | Items you start with.
src/Dodge/Creature/Action.hs
+12 -3
View File
@@ -115,9 +115,12 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], AimAt tcid tpos)
cdir = _crDir cr
cpos = cr ^. crPos . _xy
canSee' = canSee (_crID cr) tcid w
aimSp = case crMvType cr ^? mvAimSpeed of
aimSp = case crMvType cr ^? mvTurnRad of
Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
Nothing -> error "creature without aiming type"
-- aimSp = case crMvType cr ^? mvAimSpeed of
-- Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
-- Nothing -> error "creature without aiming type"
tpos
| canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy
| otherwise = p
@@ -135,9 +138,15 @@ performPathTo a cr w p
Just q -> gotowards q
_ -> ([], a)
where
gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , PathTo p a)
gotowards q = ( crMoveImpulses cr q , PathTo p a)
cpos = cr ^. crPos . _xy
jit = _mvTurnJit $ crMvType cr
crMoveImpulses :: Creature -> Point2 -> [Impulse]
crMoveImpulses cr p = case crMvType cr of
NoMvType -> [MvTurnToward p, MvForward]
MvWalking {} -> [MvTurnToward p, MvForward]
JitMvType {_mvTurnJit = x} -> [MvTurnToward p, MvForward, RandomTurn x]
StartStopMvType {} -> [MvTurnToward p, MvForward]
performTurnToA :: Creature -> Point2 -> ActionUpdate
performTurnToA cr p
src/Dodge/Creature/ChaseCrit.hs
+2 -2
View File
@@ -91,7 +91,7 @@ beeCrit =
defaultCreature
& crName .~ "beeCrit"
& crHP .~ HP 100
& crType .~ BeeCrit 0 Nothing
& crType .~ BeeCrit 0 Nothing 0
& crFaction .~ ColorFaction yellow
& crStance . carriage .~ Flying 15
@@ -100,6 +100,6 @@ hiveCrit =
defaultCreature
& crName .~ "hiveCrit"
& crHP .~ HP 100000
& crType .~ HiveCrit [] 0
& crType .~ HiveCrit mempty 0
& crStance . carriage .~ Rooted
& crFaction .~ ColorFaction yellow
src/Dodge/Creature/Impulse.hs
+7 -3
View File
@@ -3,6 +3,7 @@
module Dodge.Creature.Impulse (followImpulse) where
import Control.Applicative
import Control.Monad.Trans.State.Lazy
--import Control.Monad.State -- moving from mtl to transformers
import Data.Maybe
@@ -70,7 +71,7 @@ followImpulse cid w = \case
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ followImpulse cid w (doCrImp f tcr)
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld)
MvForward -> crup $ crMvForward' (w ^. cWorld . lWorld)
MvTurnToward p ->
crup $
creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
@@ -79,8 +80,11 @@ followImpulse cid w = \case
cr = w ^?! cWorld . lWorld . creatures . ix cid
crup f = over clens f w
mvType = crMvType cr
speed = _mvSpeed mvType
turnRad = doFloatFloat $ _mvTurnRad mvType
-- speed = _mvSpeed mvType
turnRad = fromMaybe (const 0.1) $
mvType ^? mvTurnRad . to doFloatFloat
<|> mvType ^? mvTurnSpeed . to const
-- | Just x <- = doFloatFloat $ _mvTurnRad mvType
cpos = cr ^. crPos . _xy
cdir = _crDir cr
posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy
src/Dodge/Creature/Impulse/Movement.hs
+16 -6
View File
@@ -6,9 +6,11 @@ module Dodge.Creature.Impulse.Movement (
crWalk,
crMvByNoStride,
crMvForward,
crMvForward',
creatureTurnTo,
) where
import Dodge.Creature.MoveType
import Linear
import Control.Lens
import Dodge.Base
@@ -19,13 +21,9 @@ import Geometry
{- | Creature attempts to moves under its own steam.
The idea is that this may or may not work, depending on the status of the creature.
For now, though, this cannot fail.
p is the movement translation vector, will be made relative to creature direction
-}
crMvBy ::
-- | Movement translation vector, will be made relative to creature direction
Point2 ->
LWorld ->
Creature ->
Creature
crMvBy :: Point2 -> LWorld -> Creature -> Creature
crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr
crWalk ::
@@ -72,6 +70,18 @@ strengthFactor i
| i < 1 = 0
| otherwise = 0.02 * fromIntegral i
crMvForward' :: LWorld -> Creature -> Creature
crMvForward' lw cr = case crMvType cr of
JitMvType s _ _ -> crMvBy (V2 s 0) lw cr
StartStopMvType s _ n ->
let speed | cr ^?! crType . startStopMv > n = 0
| otherwise = s
in crMvBy (V2 speed 0) lw cr
& crType . startStopMv %~ ((`mod` (n*2)) . (+1))
NoMvType -> cr
MvWalking s -> crMvBy (V2 s 0) lw cr
crMvForward :: Float -> LWorld -> Creature -> Creature
crMvForward speed = crMvBy (V2 speed 0)
src/Dodge/Creature/MoveType.hs
+5 -5
View File
@@ -17,24 +17,24 @@ crMvType cr = case _crType cr of
BarrelCrit {} -> defaultAimMvType
LampCrit {} -> defaultAimMvType
SlimeCrit {} -> NoMvType
BeeCrit {} -> defaultChaseMvType & mvSpeed .~ 0.1
BeeCrit {} -> StartStopMvType 0.2 0.1 25
HiveCrit{} -> NoMvType
defaultAimMvType :: CrMvType
defaultAimMvType =
CrMvType
JitMvType
{ _mvSpeed = 3
, _mvTurnRad = FloatConst 0.2
, _mvTurnJit = 0.05
, _mvAimSpeed = FloatAbsCheckGreaterLess (pi / 8) 0.2 0.01
-- , _mvAimSpeed = FloatAbsCheckGreaterLess (pi / 8) 0.2 0.01
}
defaultChaseMvType :: CrMvType
defaultChaseMvType =
CrMvType
JitMvType
{ _mvSpeed = 2
, _mvTurnRad = FloatAbsCheckGreaterLess (pi / 4) 0.2 0.05
--, _mvTurnJit = 0.3
, _mvTurnJit = 0.05
, _mvAimSpeed = FloatAbsCheckGreaterLess (pi / 8) 0.2 0.01
-- , _mvAimSpeed = FloatAbsCheckGreaterLess (pi / 8) 0.2 0.01
}
src/Dodge/Creature/Update.hs
+33 -17
View File
@@ -3,6 +3,7 @@
module Dodge.Creature.Update (updateCreature) where
--import Dodge.WorldEvent.ThingsHit
import Data.List (sortOn)
import Dodge.Creature.Radius
import Dodge.Zoning.Creature
import Dodge.Creature.ChaseCrit
@@ -37,6 +38,7 @@ import qualified Quaternion as Q
import RandomHelp
import Shape
import ShapePicture.Data
import qualified Data.IntSet as IS
-- Should separate out creature movement from other parts here
-- allow for knockbacks etc to be determined as well as intended movements
@@ -81,18 +83,19 @@ updateLivingCreature cr = case cr ^. crType of
updateHiveCrit :: Creature -> Int -> World -> World
updateHiveCrit cr cid w
| Just x <- cr ^? crType . hiveChildren . to length
, x < 10
| Just x <- cr ^? crType . hiveChildren . to IS.size
, x < nbees
, Just y <- cr ^? crType . hiveGestation
, y == 0 = w
& tocr . crType . hiveChildren .:~ nid
& tocr . crType . hiveChildren %~ IS.insert nid
& tocr . crType . hiveGestation .~ 50
& cWorld . lWorld . creatures . at nid ?~ ncr
| Just x <- cr ^? crType . hiveChildren . to length
, x < 10 = w
| Just x <- cr ^? crType . hiveChildren . to IS.size
, x < nbees = w
& tocr . crType . hiveGestation %~ (max 0 . subtract 1)
| otherwise = w
where
nbees = 10
tocr = cWorld . lWorld . creatures . ix cid
nid = IM.newKey $ w ^. cWorld . lWorld . creatures
ncr = beeCrit & crPos .~ (cr ^. crPos + (0 & _xy +~ 25))
@@ -107,32 +110,37 @@ updateBeeCrit cr cid w
, x >= 0.5
= w & tocr . crType . beeSlime -~ 0.5
| Just hcr <- gethive
, Just mid <- cr ^? crStance . carriage . mountID
, Just _ <- cr ^? crStance . carriage . mountID
, Just x <- cr ^? crType . beeSlime
, x >= 15 || mountshakeoff mid
, x >= 15
= w & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
& tocr . crStance . carriage .~ Flying 0
| Just mid <- cr ^? crStance . carriage . mountID
, mountshakeoff mid = w & tocr . crActionPlan . apStrategy .~ Search
& tocr . crStance . carriage .~ Flying 0
| Just hcr <- gethive
, Just x <- cr ^? crType . beeSlime
, x >= 15
= w & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
| Nothing <- cr ^? crActionPlan . apStrategy . harvestTarget
, Just tcr <- find isslime $ crsNearCirc (cr ^. crPos . _xy) 100 w =
, Just tcr <- listToMaybe . sortOn (distance cxy . (^. crPos . _xy)) . IM.elems . IM.filter istarget $ 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)
, 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
& cWorld . lWorld . creatures . ix tid . crType . slimeRad %~ (sqrt . subtract sspeed . (^(2::Int)))
| Just (tcr,ti) <- gettarg
, distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.9*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)))
& tocr . crActionPlan . apAction .~ NoAction
| Just (tcr,_) <- gettarg = w
& tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
| otherwise = w & tocr . crActionPlan . apStrategy .~ Search
where
cxy = cr ^. crPos . _xy
mountshakeoff mid = fromMaybe True $ do
mcr <- w ^? cWorld . lWorld . creatures . ix mid
SlimeCrit {_slimeSplitTimer = x} <- mcr ^? crType
@@ -148,9 +156,9 @@ updateBeeCrit cr cid w
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
istarget tcr = fromMaybe False $ do
r <- tcr ^? crType . slimeRad
return $ r > 12
slimeCritUpdate :: Int -> World -> World
slimeCritUpdate cid w
@@ -323,11 +331,19 @@ checkDeath' cr w = case cr ^. crHP of
& dropAll cr -- the order of these is possibly important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
& crEffectsOnDeath cr
& tocr . crStance . carriage %~ toDeathCarriage
_ -> w
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
crEffectsOnDeath :: Creature -> World -> World
crEffectsOnDeath cr w = case cr ^. crType of
BeeCrit {_beeHive = mhid} -> fromMaybe w $ do
hid <- mhid
return $ w & cWorld . lWorld . creatures . ix hid . crType . hiveChildren %~ IS.delete (cr ^. crID)
_ -> w
startDeathTimer :: Creature -> Creature
startDeathTimer cr = cr & crDeathTimer ?~ case cr ^. crType of
HoverCrit{} -> 0
src/Dodge/Data/Creature/Misc.hs
+9 -7
View File
@@ -15,6 +15,7 @@ import Dodge.Data.CamouflageStatus
import Dodge.Data.FloatFunction
import Dodge.Data.Material
import Geometry.Data
import qualified Data.IntSet as IS
data Vocalization
= VocTimer {_vcTime :: Int ,_vcMaxTime :: Int }
@@ -25,16 +26,16 @@ data CrMvType
= NoMvType
| MvWalking {_mvSpeed :: Float} -- note this may interact with a friction element
-- so currently 26.04.03 the actual max speed when walking is twice this
| CrMvType
| JitMvType
{ _mvSpeed :: Float
, _mvTurnRad :: FloatFloat
, _mvTurnJit :: Float
, _mvAimSpeed :: FloatFloat
}
-- | CrAccMv
-- { _mvAcc :: Float
-- , _mvTopSpeed :: Float
-- }
| StartStopMvType
{ _mvSpeed :: Float
, _mvTurnSpeed :: Float
, _mvPulseTime :: Int
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Pulse = PulseStatus
@@ -82,9 +83,10 @@ data CreatureType
| BeeCrit
{ _beeSlime :: Float
, _beeHive :: Maybe Int
, _startStopMv :: Int
}
| HiveCrit
{ _hiveChildren :: [Int]
{ _hiveChildren :: IS.IntSet
, _hiveGestation :: Int
}
| SwarmCrit
src/Dodge/Default/Creature.hs
-2
View File
@@ -49,8 +49,6 @@ defaultCreature =
, _crFaction = NoFaction
, _crIntention = defaultIntention
, _crGroup = LoneWolf
-- , _crMvType = defaultAimMvType
-- , _crHammerPosition = HammerUp
, _crName = "DEFAULTCRNAME"
-- , _crStatistics = CreatureStatistics 50 50 50
, _crDeathTimer = Nothing
src/Dodge/Room/Tutorial.hs
+1 -1
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 beeCrit) & plSpot . psPos .~ V2 250 100
, sps0 (PutCrit hiveCrit) & plSpot . psPos .~ V2 250 50
, sps0 (PutCrit chaseCrit) & plSpot . psPos .~ V2 250 100
]
)
-- , tToBTree "" . return . cleatOnward <$> (cChasm
src/Dodge/TestString.hs
+2
View File
@@ -44,6 +44,8 @@ tocrs = uvWorld . cWorld . lWorld . creatures
testStringInit :: Universe -> [String]
testStringInit u = u ^.. tocrs . ix 2 . crType . hiveChildren . to show
<> u ^.. tocrs . ix 3 . crStance . carriage . to show
<> u ^.. tocrs . ix 3 . crDir . to show
<> u ^.. tocrs . ix 3 . crActionPlan . apAction . 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