From b43168ae338e5e9a963d8cd505c5a9bf0f416362 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 18 Oct 2025 14:34:05 +0100 Subject: [PATCH] Simplify creature impulse chain --- src/Dodge/Creature/ChainUpdates.hs | 6 +-- src/Dodge/Creature/Impulse.hs | 80 ++++++++++++++---------------- src/Dodge/Creature/Update.hs | 2 +- src/Dodge/Humanoid.hs | 6 ++- 4 files changed, 44 insertions(+), 50 deletions(-) diff --git a/src/Dodge/Creature/ChainUpdates.hs b/src/Dodge/Creature/ChainUpdates.hs index 8e487ade5..541d27868 100644 --- a/src/Dodge/Creature/ChainUpdates.hs +++ b/src/Dodge/Creature/ChainUpdates.hs @@ -3,11 +3,7 @@ module Dodge.Creature.ChainUpdates where import Data.Foldable import Dodge.Data.World -chainCreatureUpdates :: - [World -> Creature -> Creature] -> - World -> - Creature -> - Creature +chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature chainCreatureUpdates ls w cr = foldl' unf cr ls where unf cr' g = g w cr' diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index ed2c263c1..ee72a89c3 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -1,14 +1,13 @@ {-# LANGUAGE TupleSections #-} -module Dodge.Creature.Impulse (impulsiveAIBefore) where +module Dodge.Creature.Impulse (followImpulses) where import Data.Maybe -import Linear import NewInt +import Linear import Dodge.Creature.MoveType import Data.Foldable import Control.Monad.State -import Data.Bifunctor import Dodge.Creature.Impulse.Movement --import Dodge.Creature.Impulse.UseItem import Dodge.Creature.Vocalization @@ -21,64 +20,59 @@ import Geometry import LensHelp import System.Random -impulsiveAIBefore :: - (World -> Creature -> Creature) -> - Creature -> - World -> - 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 w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr) +-- where +-- f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp -followImpulses :: World -> Creature -> (World -> World, Creature) -followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr) - where - f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp +followImpulses :: Int -> World -> World +followImpulses cid w = foldl' (followImpulse cid) w + (reverse $ w ^?! cWorld . lWorld . creatures . ix cid . crActionPlan . apImpulse) -- note SwitchToItem doesn't necessarily update the root item correctly -followImpulse :: Creature -> World -> Impulse -> (World -> World, Creature) -followImpulse cr w imp = case imp of - ImpulseNothing -> (id, cr) +followImpulse :: Int -> World -> Impulse -> World +followImpulse cid w imp = case imp of + ImpulseNothing -> w RandomImpulse rimp -> let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w) - in first ((randGen .~ newgen) .) $ followImpulse cr w newimp - Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w cr) - Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) cr - MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr - MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld) cr - Turn a -> crup $ cr & crDir +~ a - TurnToward p a -> crup $ creatureTurnToward p a cr - TurnTo p -> crup $ creatureTurnTo p cr - ChangePosture post -> crup $ cr & crStance . posture .~ post + in randGen .~ newgen $ followImpulse cid w newimp + Bark sid -> soundStart (CrMouth cid) cpos sid Nothing + $ w & clens %~ resetCrVocCoolDown w + Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) + MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) + MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld) + Turn a -> crup $ crDir +~ a + TurnToward p a -> crup $ creatureTurnToward p a + TurnTo p -> crup $ creatureTurnTo p + ChangePosture post -> crup $ crStance . posture .~ post UseItem -> undefined --- UseItem -> (useSelectedItem $ _crID cr --- , cr) - SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty + SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty Melee cid' -> - ( hitCr cid' - , crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20 - ) - RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a)) - MakeSound sid -> (soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing, cr) + hitCr cid' $ crup ( + (crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos))) . (crType . meleeCooldown .~ 20)) + RandomTurn a -> let (aa,g) = rr a + in (randGen .~ g) (crup (crDir +~ aa)) + MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w DropItem -> undefined - ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat - AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl - ImpulseUseTarget f -> fromMaybe (crup cr) $ do + ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat + AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl + ImpulseUseTarget f -> fromMaybe w $ do i <- cr ^? crIntention . targetCr . _Just tcr <- w ^? cWorld . lWorld . creatures . ix i - return $ followImpulse cr w (doCrImp f tcr) - MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr + return $ followImpulse cid w (doCrImp f tcr) + MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) MvTurnToward _ _ _ p -> crup $ - creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr + creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) 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 speed = _mvSpeed mvType turnRad = doFloatFloat $ _mvTurnRad mvType cpos = cr ^. crPos . _xy cdir = _crDir cr - cid = _crID cr posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy rr a = randomR (- a, a) $ _randGen w hitCr i = diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index 9f52531a3..730c56fc3 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -47,7 +47,7 @@ updateCreature' cr = LampCrit{} -> updateLampoid cr BarrelCrit bt -> updateBarreloid bt cr AvatarDead -> id - ChaseCrit {} -> crUpdate cid . updateHumanoid cr + ChaseCrit {} -> crUpdate cid . updateHumanoid cr _ -> crUpdate cid . updateHumanoid cr where cid = cr ^. crID diff --git a/src/Dodge/Humanoid.hs b/src/Dodge/Humanoid.hs index 7c69b93df..74d0b4549 100644 --- a/src/Dodge/Humanoid.hs +++ b/src/Dodge/Humanoid.hs @@ -1,5 +1,6 @@ module Dodge.Humanoid where +import Dodge.Creature.Impulse import Linear import Data.Maybe import Dodge.Creature.Action @@ -180,7 +181,10 @@ updateHumanoid cr = case cr ^?! crType of -- ] 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 cr w =