From 11c7b25fe907c01d6e347064e407a9fa48b8c1b3 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 18 Oct 2025 16:00:08 +0100 Subject: [PATCH] Cleanup impulses/actions --- src/Dodge/Creature/Boid.hs | 126 ++++++++++++++++--------------- src/Dodge/Creature/Impulse.hs | 40 +++++----- src/Dodge/Creature/SentinelAI.hs | 2 +- src/Dodge/Room/Tutorial.hs | 10 +-- 4 files changed, 95 insertions(+), 83 deletions(-) diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs index 04e596474..745ff7c10 100644 --- a/src/Dodge/Creature/Boid.hs +++ b/src/Dodge/Creature/Boid.hs @@ -4,7 +4,7 @@ import Data.Maybe import Linear import Dodge.Creature.Radius import Control.Lens -import Control.Monad.Reader +--import Control.Monad.Reader import Dodge.Base import Dodge.Data.World import Geometry @@ -208,13 +208,21 @@ flockPointTarget :: World -> Creature -> Creature -flockPointTarget f targFunc w cr = case targFunc cr w of - Nothing -> cr - Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg - where - is = _swarm $ _crGroup cr - crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is - p = f crTarg crs cr +flockPointTarget _ _ _ = id +--flockPointTarget :: +-- (Creature -> IM.IntMap Creature -> Creature -> Point2) -> +-- -- | Function for determining target +-- (Creature -> World -> Maybe Creature) -> +-- World -> +-- Creature -> +-- Creature +--flockPointTarget f targFunc w cr = case targFunc cr w of +-- Nothing -> cr +-- Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg +-- where +-- is = _swarm $ _crGroup cr +-- crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is +-- p = f crTarg crs cr --flockToPointUsing :: -- (Creature -> Point2 -> Creature -> Point2) -> @@ -229,60 +237,60 @@ flockPointTarget f targFunc w cr = case targFunc cr w of -- -- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) -- ptarg = pf tcr cenp cr -flockToPointUsing' :: - (Creature -> Point2 -> Creature -> Point2) -> - (Point2 -> Creature -> Creature -> [Impulse]) -> - World -> - Creature -> - Creature -flockToPointUsing' pf mvf w cr = fromMaybe cr $ do - i <- _targetCr $ _crIntention cr - tcr <- w ^? cWorld . lWorld . creatures . ix i - let ptarg = pf tcr cenp cr - return $ cr -- & crActionPlan . apImpulse .~ mvf ptarg cr tcr - where - cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter +--flockToPointUsing' :: +-- (Creature -> Point2 -> Creature -> Point2) -> +-- (Point2 -> Creature -> Creature -> [Impulse]) -> +-- World -> +-- Creature -> +-- Creature +--flockToPointUsing' pf mvf w cr = fromMaybe cr $ do +-- i <- _targetCr $ _crIntention cr +-- tcr <- w ^? cWorld . lWorld . creatures . ix i +-- let ptarg = pf tcr cenp cr +-- return $ cr -- & crActionPlan . apImpulse .~ mvf ptarg cr tcr +-- where +-- cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter -flockFunc :: - (Creature -> Point2 -> Creature -> Point2) -> - -- | Function for determining target - (Creature -> World -> Maybe Creature) -> - Creature -> - Reader World Creature -flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of - Nothing -> cr - Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg - where - cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter - p = f crTarg cenp cr +--flockFunc :: +-- (Creature -> Point2 -> Creature -> Point2) -> +-- -- | Function for determining target +-- (Creature -> World -> Maybe Creature) -> +-- Creature -> +-- Reader World Creature +--flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of +-- Nothing -> cr +-- Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg +-- where +-- cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter +-- p = f crTarg cenp cr -flockCenterFunc :: - (Creature -> Point2 -> Creature -> Point2) -> - -- | Function for determining target - (Creature -> World -> Maybe Creature) -> - Creature -> - Reader World Creature -flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of - Nothing -> cr - Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg - where - cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter - p = f crTarg cenp cr +--flockCenterFunc :: +-- (Creature -> Point2 -> Creature -> Point2) -> +-- -- | Function for determining target +-- (Creature -> World -> Maybe Creature) -> +-- Creature -> +-- Reader World Creature +--flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of +-- Nothing -> cr +-- Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg +-- where +-- cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter +-- p = f crTarg cenp cr -flockPointTargetR :: - (Creature -> IM.IntMap Creature -> Creature -> Point2) -> - -- | Function for determining target - (Creature -> World -> Maybe Creature) -> - Creature -> - Reader World Creature -flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of - Nothing -> cr - Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg - where - is = _swarm $ _crGroup cr - --crs = IM.restrictKeys (_creatures (_cWorld w)) is - crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is - p = f crTarg crs cr +--flockPointTargetR :: +-- (Creature -> IM.IntMap Creature -> Creature -> Point2) -> +-- -- | Function for determining target +-- (Creature -> World -> Maybe Creature) -> +-- Creature -> +-- Reader World Creature +--flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of +-- Nothing -> cr +-- Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg +-- where +-- is = _swarm $ _crGroup cr +-- --crs = IM.restrictKeys (_creatures (_cWorld w)) is +-- crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is +-- p = f crTarg crs cr meleeHeadingMove :: -- | max turn speed diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 1bedbccfb..d5690e923 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -2,14 +2,12 @@ module Dodge.Creature.Impulse (followImpulses) where -import Dodge.Creature.Action -import Data.Maybe -import NewInt -import Linear -import Dodge.Creature.MoveType -import Data.Foldable import Control.Monad.State +import Data.Foldable +import Data.Maybe +import Dodge.Creature.Action import Dodge.Creature.Impulse.Movement +import Dodge.Creature.MoveType --import Dodge.Creature.Impulse.UseItem import Dodge.Creature.Vocalization import Dodge.CreatureEffect @@ -19,12 +17,14 @@ import Dodge.RandImpulse import Dodge.SoundLogic import Geometry import LensHelp +import Linear +import NewInt import System.Random followImpulses :: Int -> World -> World -followImpulses cid w = let (is,cr) = performActions w (w ^?! cWorld . lWorld . creatures . ix cid) - in foldl' (followImpulse cid) (w & cWorld . lWorld . creatures . ix cid .~ cr) - (reverse is) +followImpulses cid w = + let (is, cr) = performActions w (w ^?! cWorld . lWorld . creatures . ix cid) + in foldl' (followImpulse cid) (w & cWorld . lWorld . creatures . ix cid .~ cr) is -- note SwitchToItem doesn't necessarily update the root item correctly followImpulse :: Int -> World -> Impulse -> World @@ -33,22 +33,26 @@ followImpulse cid w imp = case imp of RandomImpulse rimp -> let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w) in randGen .~ newgen $ followImpulse cid w newimp - Bark sid -> soundStart (CrMouth cid) cpos sid Nothing - $ w & clens %~ resetCrVocCoolDown w + 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 + TurnTo p -> crup $ creatureTurnTo p ChangePosture post -> crup $ crStance . posture .~ post UseItem -> undefined SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty Melee cid' -> - 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)) + 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 $ crActionPlan . apStrategy .~ strat @@ -73,5 +77,5 @@ followImpulse cid w imp = case imp of posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy rr a = randomR (- a, a) $ _randGen w hitCr i = - cWorld . lWorld . creatures . ix i . crDamage - .:~ Blunt 100 (posFromID i) (posFromID i-cpos) + cWorld . lWorld . creatures . ix i . crDamage + .:~ Blunt 100 (posFromID i) (posFromID i - cpos) diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 6e377fd43..03098dc1c 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -6,7 +6,7 @@ module Dodge.Creature.SentinelAI ( import Control.Lens import Data.Maybe -import Dodge.Creature.Action +--import Dodge.Creature.Action import Dodge.Creature.ChainUpdates import Dodge.Creature.Perception import Dodge.Creature.ReaderUpdate diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index c05512b10..deff5b700 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/src/Dodge/Room/Tutorial.hs @@ -1,6 +1,6 @@ module Dodge.Room.Tutorial where ---import Dodge.Room.LongDoor +import Dodge.Room.LongDoor import Dodge.Layout import Dodge.Item.Held.Utility import Control.Monad @@ -43,10 +43,10 @@ tutAnoTree = do foldMTRS [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox , corDoor --- , corDoor --- , tToBTree "t" . return . cleatOnward <$> slowDoorRoom --- , corDoor --- , corDoor + , corDoor + , tToBTree "t" . return . cleatOnward <$> slowDoorRoom + , corDoor + , corDoor , tutHub , tutLight , tutDrop