Add bee random movement

This commit is contained in:
2026-05-02 15:55:59 +01:00
parent 199f1b11b5
commit 31f24283d7
10 changed files with 168 additions and 165 deletions
+3 -3
View File
@@ -92,8 +92,8 @@ performAction cr w ac = case ac of
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], NoAction)
UseSelf f -> performAction cr w $ doCrAc f cr
ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
-- UseSelf f -> performAction cr w $ doCrAc f cr
-- ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
DoImpulsesAlongside sideImp mainAc -> performAction cr w mainAc & _1 <>~ sideImp
DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
DoReplicatePartial _ 0 pac -> performAction cr w pac
@@ -147,7 +147,7 @@ crMoveImpulses cr p = case crMvType cr of
MvWalking {} -> [MvTurnToward p, MvForward]
JitMvType {_mvTurnJit = x} -> [MvTurnToward p, MvForward, RandomTurn x]
StartStopMvType {} -> [MvTurnToward p, MvForward]
BeeMvType {} | cr ^?! crType . beeRandomMovement -> [MvForward]
BeeMvType {} | cr ^?! crType . startStopMv == 0 -> [SetBeeRandomMovement, MvForward, MvTurnToward p]
BeeMvType {} -> [MvTurnToward p, MvForward]
performTurnToA :: Creature -> Point2 -> ActionUpdate
+1 -1
View File
@@ -91,7 +91,7 @@ beeCrit =
defaultCreature
& crName .~ "beeCrit"
& crHP .~ HP 100
& crType .~ BeeCrit 0 Nothing 0 0 0 False
& crType .~ BeeCrit 0 Nothing 0 0 0 Nothing
& crFaction .~ ColorFaction yellow
& crStance . carriage .~ Flying 15
+15 -2
View File
@@ -3,8 +3,9 @@
module Dodge.Creature.Impulse (followImpulse) where
import RandomHelp
import Control.Applicative
import Control.Monad.Trans.State.Lazy
--import Control.Monad.Trans.State.Lazy
--import Control.Monad.State -- moving from mtl to transformers
import Data.Maybe
import Dodge.Creature.Impulse.Movement
@@ -19,7 +20,7 @@ import Dodge.SoundLogic
import Geometry
import LensHelp
import Linear
import System.Random
--import System.Random
-- note SwitchToItem doesn't necessarily update the root item correctly
followImpulse :: Int -> World -> Impulse -> World
@@ -75,6 +76,7 @@ followImpulse cid w = \case
MvTurnToward p ->
crup $
mvTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
SetBeeRandomMovement -> w & setBeeRandomMovement cid
where
clens = cWorld . lWorld . creatures . ix cid
cr = w ^?! cWorld . lWorld . creatures . ix cid
@@ -97,3 +99,14 @@ followImpulse cid w = \case
<>~ [Blunt 100 (posFromID i) (posFromID i - cpos) (CrMeleeO cid)
, Inertial 0 (posFromID i) (50 * unitVectorAtAngle (cr ^. crDir + a)) (CrMeleeO cid)
]
setBeeRandomMovement :: Int -> World -> World
setBeeRandomMovement cid w = fromMaybe w $ do
mff <- w ^? cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement
return $ case mff of
Just _ -> w & cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement .~ Nothing
Nothing -> w & cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement .~ x
& randGen .~ g
where
(x,g) = runState (takeOne [Nothing,Just LeftForward,Just RightForward]) (w ^. randGen)
+5 -1
View File
@@ -83,7 +83,11 @@ crMvForward' lw cr = case crMvType cr of
BeeMvType s _ n ->
let speed | cr ^?! crType . startStopMv > n = 0
| otherwise = s
in crMvBy (V2 speed 0) lw cr
v = case cr ^?! crType . beeRandomMovement of
Nothing -> V2 speed 0
Just LeftForward -> V2 0 speed
Just RightForward -> V2 0 (-speed)
in crMvBy v lw cr
& crType . startStopMv %~ ((`mod` (n*2)) . (+1))
NoMvType -> cr
MvWalking s -> crMvBy (V2 s 0) lw cr
+9 -9
View File
@@ -25,7 +25,7 @@ import Dodge.Base
import Dodge.Creature.Perception
import Dodge.Creature.Radius
import Dodge.Creature.Vocalization
import Dodge.Data.CreatureEffect
--import Dodge.Data.CreatureEffect
import Dodge.Data.World
import Dodge.Zoning.Creature
import FoldableHelp
@@ -141,7 +141,7 @@ crabActionUpdate cid w = case _apStrategy (_crActionPlan cr) of
| dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
w & tocr . crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
| otherwise ->
w & tocr . crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
w -- & tocr . crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
& tocr . crActionPlan . apStrategy .~ Search
& tocr . crIntention . mvToPoint .~ Nothing
_ -> w & tocr %~ viewTarget w
@@ -215,8 +215,8 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
| dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
| otherwise ->
cr & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
& crActionPlan . apStrategy .~ WatchAndWait
cr -- & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
& crActionPlan . apStrategy .~ Search
& crIntention . mvToPoint .~ Nothing
_ -> viewTarget w cr
where
@@ -235,8 +235,8 @@ hoverCritMv w cr = case _apStrategy (_crActionPlan cr) of
| dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
| otherwise ->
cr & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
& crActionPlan . apStrategy .~ WatchAndWait
cr -- & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
& crActionPlan . apStrategy .~ Search
& crIntention . mvToPoint .~ Nothing
_ -> viewTarget w cr
where
@@ -319,12 +319,12 @@ searchIfDamaged cr
.~ SetStrategyAction
LookAround
( TurnToPoint (cr ^. crPos . _xy -.- unitVectorAtAngle (_crDir cr))
`DoActionThen` 40 `WaitThen` bfsThenReturn 500
-- `DoActionThen` 40 `WaitThen` bfsThenReturn 500
)
| otherwise = cr
bfsThenReturn :: Int -> Action
bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
--bfsThenReturn :: Int -> Action
--bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
-- theaction
-- where
+4 -13
View File
@@ -36,18 +36,9 @@ doCrBl cb = case cb of
CrIsAnimate -> isAnimate
CrOpenAutoDoor -> \cr -> isAnimate cr && hasAutoDoorBody cr
doCrAc :: CrAc -> Creature -> Action
doCrAc ca = case ca of
CrTurnAround -> \cr -> TurnToPoint
(cr ^. crPos . _xy -.- 10 *.* unitVectorAtAngle (_crDir cr))
-- CrFleeFromTarget -> fleeFromTarget
--fleeFromTarget :: Creature -> Action
--fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr))
doCrWdAc :: CrWdAc -> Creature -> World -> Action
doCrWdAc cw = case cw of
CrWdBFSThenReturn _ -> const $ const NoAction
--doCrWdAc :: CrWdAc -> Creature -> World -> Action
--doCrWdAc cw = case cw of
-- CrWdBFSThenReturn _ -> const $ const NoAction
-- CrWdBFSThenReturn t -> \cr w -> fromMaybe NoAction $ do
-- n <- walkableNodeNear w (cr ^. crPos . _xy)
-- let as = take 20 $ map PathTo $ bfsNodePoints n w
@@ -56,7 +47,7 @@ doCrWdAc cw = case cw of
-- DoReplicate t $
-- foldr DoActionThen NoAction as
-- ChooseMovementSpreadGun -> chooseMovementSpreadGun
ChooseMovementLtAuto -> chooseMovementLtAuto
-- ChooseMovementLtAuto -> chooseMovementLtAuto
--chooseMovementSpreadGun :: Creature -> World -> Action
--chooseMovementSpreadGun cr w
+3 -2
View File
@@ -49,6 +49,7 @@ data Impulse
| ImpulseUseTarget { _impulseUseTarget :: CrImp }
| ImpulseNothing
| UpdateRandGen
| SetBeeRandomMovement
deriving (Eq, Ord, Show) --Generic, Flat)
data RandImpulse
@@ -121,8 +122,8 @@ data Action
| LeadTarget { _leadTargetBy :: Point2 }
| NoAction
| StartSentinelPost
| UseSelf { _useSelf :: CrAc }
| ArbitraryAction {_arbitraryAction :: CrWdAc}
-- | UseSelf { _useSelf :: CrAc }
-- | ArbitraryAction {_arbitraryAction :: CrWdAc}
-- | Repeatedly perform impulses alongside a main action until the main action terminates
| DoImpulsesAlongside
{ _sideImpulses :: [Impulse]
+1 -1
View File
@@ -91,7 +91,7 @@ data CreatureType
, _startStopMv :: Int
, _beeAggro :: Int
, _meleeCooldown :: Int
, _beeRandomMovement :: Bool
, _beeRandomMovement :: Maybe FootForward
}
| HiveCrit
{ _hiveChildren :: IS.IntSet
+6 -6
View File
@@ -24,14 +24,14 @@ data CrBl = CrCanShoot | CrIsAiming | CrIsAnimate
data CrAc = CrTurnAround
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CrWdAc
= CrWdBFSThenReturn Int
-- | ChooseMovementSpreadGun
| ChooseMovementLtAuto
deriving (Eq, Ord, Show, Read) --Generic, Flat)
--data CrWdAc
-- = CrWdBFSThenReturn Int
---- | ChooseMovementSpreadGun
---- | ChooseMovementLtAuto
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriveJSON defaultOptions ''CrImp
deriveJSON defaultOptions ''CrBl
deriveJSON defaultOptions ''WdCrBl
deriveJSON defaultOptions ''CrAc
deriveJSON defaultOptions ''CrWdAc
--deriveJSON defaultOptions ''CrWdAc