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

Simplify creature impulse chain

Browse Source
This commit is contained in:
justin
2025-10-18 14:34:05 +01:00
parent ebc4b9d715
commit b43168ae33
4 changed files with 44 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/ChainUpdates.hs
+1 -5
View File
@@ -3,11 +3,7 @@ module Dodge.Creature.ChainUpdates where
import Data.Foldable import Data.Foldable
import Dodge.Data.World import Dodge.Data.World
chainCreatureUpdates :: chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature
[World -> Creature -> Creature] ->
World ->
Creature ->
Creature
chainCreatureUpdates ls w cr = foldl' unf cr ls chainCreatureUpdates ls w cr = foldl' unf cr ls
where where
unf cr' g = g w cr' unf cr' g = g w cr'
src/Dodge/Creature/Impulse.hs
+37 -43
View File
@@ -1,14 +1,13 @@
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
module Dodge.Creature.Impulse (impulsiveAIBefore) where module Dodge.Creature.Impulse (followImpulses) where
import Data.Maybe import Data.Maybe
import Linear
import NewInt import NewInt
import Linear
import Dodge.Creature.MoveType import Dodge.Creature.MoveType
import Data.Foldable import Data.Foldable
import Control.Monad.State import Control.Monad.State
import Data.Bifunctor
import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.Movement
--import Dodge.Creature.Impulse.UseItem --import Dodge.Creature.Impulse.UseItem
import Dodge.Creature.Vocalization import Dodge.Creature.Vocalization
@@ -21,64 +20,59 @@ import Geometry
import LensHelp import LensHelp
import System.Random import System.Random
impulsiveAIBefore :: --followImpulses :: World -> Creature -> (World -> World, Creature)
(World -> Creature -> Creature) -> --followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr)
Creature -> -- where
World -> -- f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
World
impulsiveAIBefore f cr w = g w & cWorld . lWorld . creatures . ix (_crID cr) .~ cr'
where
(g, cr') = followImpulses w $ f w cr
followImpulses :: World -> Creature -> (World -> World, Creature) followImpulses :: Int -> World -> World
followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr) followImpulses cid w = foldl' (followImpulse cid) w
where (reverse $ w ^?! cWorld . lWorld . creatures . ix cid . crActionPlan . apImpulse)
f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
-- note SwitchToItem doesn't necessarily update the root item correctly -- note SwitchToItem doesn't necessarily update the root item correctly
followImpulse :: Creature -> World -> Impulse -> (World -> World, Creature) followImpulse :: Int -> World -> Impulse -> World
followImpulse cr w imp = case imp of followImpulse cid w imp = case imp of
ImpulseNothing -> (id, cr) ImpulseNothing -> w
RandomImpulse rimp -> RandomImpulse rimp ->
let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w) let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
in first ((randGen .~ newgen) .) $ followImpulse cr w newimp in randGen .~ newgen $ followImpulse cid w newimp
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w cr) Bark sid -> soundStart (CrMouth cid) cpos sid Nothing
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) cr $ w & clens %~ resetCrVocCoolDown w
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr Move p -> crup $ crMvBy p (w ^. cWorld . lWorld)
MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld) cr MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld)
Turn a -> crup $ cr & crDir +~ a MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld)
TurnToward p a -> crup $ creatureTurnToward p a cr Turn a -> crup $ crDir +~ a
TurnTo p -> crup $ creatureTurnTo p cr TurnToward p a -> crup $ creatureTurnToward p a
ChangePosture post -> crup $ cr & crStance . posture .~ post TurnTo p -> crup $ creatureTurnTo p
ChangePosture post -> crup $ crStance . posture .~ post
UseItem -> undefined UseItem -> undefined
-- UseItem -> (useSelectedItem $ _crID cr SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
-- , cr)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
Melee cid' -> Melee cid' ->
( hitCr cid' hitCr cid' $ crup (
, crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20 (crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos))) . (crType . meleeCooldown .~ 20))
) RandomTurn a -> let (aa,g) = rr a
RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a)) in (randGen .~ g) (crup (crDir +~ aa))
MakeSound sid -> (soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing, cr) MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w
DropItem -> undefined DropItem -> undefined
ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat
AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl
ImpulseUseTarget f -> fromMaybe (crup cr) $ do ImpulseUseTarget f -> fromMaybe w $ do
i <- cr ^? crIntention . targetCr . _Just i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ followImpulse cr w (doCrImp f tcr) return $ followImpulse cid w (doCrImp f tcr)
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld)
MvTurnToward _ _ _ p -> MvTurnToward _ _ _ p ->
crup $ crup $
creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
where where
crup = (id,) clens = cWorld . lWorld . creatures . ix cid
cr = w ^?! cWorld . lWorld . creatures . ix cid
crup f = over clens f w
mvType = crMvType cr mvType = crMvType cr
speed = _mvSpeed mvType speed = _mvSpeed mvType
turnRad = doFloatFloat $ _mvTurnRad mvType turnRad = doFloatFloat $ _mvTurnRad mvType
cpos = cr ^. crPos . _xy cpos = cr ^. crPos . _xy
cdir = _crDir cr cdir = _crDir cr
cid = _crID cr
posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy
rr a = randomR (- a, a) $ _randGen w rr a = randomR (- a, a) $ _randGen w
hitCr i = hitCr i =
src/Dodge/Humanoid.hs
+5 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Humanoid where module Dodge.Humanoid where
import Dodge.Creature.Impulse
import Linear import Linear
import Data.Maybe import Data.Maybe
import Dodge.Creature.Action import Dodge.Creature.Action
@@ -180,7 +181,10 @@ updateHumanoid cr = case cr ^?! crType of
-- ] -- ]
humanoidAIList :: [World -> Creature -> Creature] -> Creature -> World -> World humanoidAIList :: [World -> Creature -> Creature] -> Creature -> World -> World
humanoidAIList = impulsiveAIBefore . chainCreatureUpdates humanoidAIList l cr w = followImpulses cid $
w & cWorld . lWorld . creatures . ix cid %~ chainCreatureUpdates l w
where
cid = cr ^. crID
chooseMovementPistol :: Creature -> World -> Action chooseMovementPistol :: Creature -> World -> Action
chooseMovementPistol cr w = chooseMovementPistol cr w =