From b8f6a29e28bed37607e680e7aa696ea3171c7143 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 18 Oct 2025 18:01:14 +0100 Subject: [PATCH] Cleanup actions/impulses --- src/Dodge/Creature/Action.hs | 107 +++++++++++++++++----------------- src/Dodge/Creature/Impulse.hs | 5 +- src/Dodge/Data/ActionPlan.hs | 4 +- tags | 45 +++++++------- 4 files changed, 79 insertions(+), 82 deletions(-) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index e93d2c16f..06857c2b2 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -11,48 +11,44 @@ module Dodge.Creature.Action ( youDropItem, ) where -import Data.Foldable -import Linear -import NewInt -import Dodge.Creature.MoveType -import Dodge.Creature.Radius -import Dodge.Item.BackgroundEffect import Control.Applicative import Control.Monad import Data.Bifunctor +import Data.Foldable import Data.Maybe import Dodge.Base import Dodge.Creature.Action.Blink +import Dodge.Creature.Impulse +import Dodge.Creature.MoveType +import Dodge.Creature.Radius import Dodge.CreatureEffect import Dodge.Data.World import Dodge.FloatFunction import Dodge.FloorItem import Dodge.Inventory +import Dodge.Item.BackgroundEffect import Dodge.Path import Dodge.SoundLogic import Geometry import qualified IntMapHelp as IM import LensHelp -import Dodge.Creature.Impulse - ---performActions :: World -> Creature -> ([Impulse],Creature) ---performActions w cr = (concat iss --- , cr & crActionPlan . apAction .~ catMaybes mayas) --- where --- (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . apAction +import Linear +import NewInt performActions :: Int -> World -> World -performActions cid w = foldl' (followImpulse cid) - (w & cWorld . lWorld . creatures . ix cid . crActionPlan . apAction .~ catMaybes mayas) - (concat iss) +performActions cid w = + foldl' + (followImpulse cid) + (w & cWorld . lWorld . creatures . ix cid . crActionPlan . apAction .~ mayas) + iss where cr = w ^?! cWorld . lWorld . creatures . ix cid - (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . apAction + (iss, mayas) = foldMap (performAction cr w) $ cr ^. crActionPlan . apAction -type OutAction = ([Impulse], Maybe Action) +type OutAction = ([Impulse], [Action]) performAimAt :: Creature -> World -> Int -> Point2 -> OutAction -performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos) +performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos]) where cdir = _crDir cr cpos = cr ^. crPos . _xy @@ -66,8 +62,11 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos) performPathTo :: Creature -> World -> Point2 -> OutAction performPathTo cr w p - | dist cpos p <= crRad (cr ^. crType) = ([], Nothing) - | isWalkable cpos p w = ([MvTurnToward 0 cpos p p, MvForward, RandomTurn jit], Just (PathTo p)) + | dist cpos p <= crRad (cr ^. crType) = ([], []) + | isWalkable cpos p w = + ( [MvTurnToward 0 cpos p p, MvForward, RandomTurn jit] + , [PathTo p] + ) | otherwise = case pointTowardsImpulse cpos p w of Just q -> ( @@ -75,17 +74,17 @@ performPathTo cr w p , MvForward , RandomTurn jit ] - , Just (PathTo p) + , [PathTo p] ) - _ -> ([ChangeStrategy Flee], Nothing) + _ -> ([ChangeStrategy Flee], []) where cpos = cr ^. crPos . _xy jit = _mvTurnJit $ crMvType cr performTurnToA :: Creature -> Point2 -> OutAction performTurnToA cr p - | angleVV cdirv dirv < 0.1 = ([], Nothing) - | otherwise = ([MvTurnToward 2 p p p, RandomTurn jit], Just (TurnToPoint p)) + | angleVV cdirv dirv < 0.1 = ([], []) + | otherwise = ([MvTurnToward 2 p p p, RandomTurn jit], [TurnToPoint p]) where cpos = cr ^. crPos . _xy cdirv = unitVectorAtAngle (_crDir cr) @@ -97,54 +96,54 @@ performTurnToA cr p -} performAction :: Creature -> World -> Action -> OutAction performAction cr w ac = case ac of - ActionNothing -> ([], Nothing) + ActionNothing -> ([], mempty) LabelAction str subAc -> second (fmap (LabelAction str)) $ performAction cr w subAc AimAt tcid p -> performAimAt cr w tcid p - WaitThen 0 newAc -> ([], Just newAc) - WaitThen t newAc -> ([], Just (WaitThen (t -1) newAc)) - ImpulsesList (xs : xss) -> (xs, Just $ ImpulsesList xss) - ImpulsesList _ -> ([], Nothing) - DoImpulses imps -> (imps, Nothing) - DoActionThen fsta afta -> case performAction cr w fsta of - (imps, Just nxta) -> (imps, Just (DoActionThen nxta afta)) - (imps, Nothing) -> (imps, Just afta) + WaitThen 0 newAc -> ([], [newAc]) + WaitThen t newAc -> ([], [WaitThen (t -1) newAc]) + ImpulsesList (xs : xss) -> (xs, [ImpulsesList xss]) + ImpulsesList _ -> ([], mempty) + DoImpulses imps -> (imps, mempty) + DoActionThen fsta afta -> case performAction cr w fsta of -- NOTE this only does ONE continuation action + (imps, nxta : _) -> (imps, [DoActionThen nxta afta]) + (imps, []) -> (imps, [afta]) DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act DoActionWhilePartial partAc f resetAc | doWdCrBl f w cr -> case performAction cr w partAc of - (imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc) - (imps, Nothing) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc) + (imps, nxta : _) -> (imps, [DoActionWhilePartial nxta f resetAc]) + (imps, []) -> (imps, [DoActionWhilePartial resetAc f resetAc]) | otherwise -> performAction cr w partAc DoActionIf f ifa | doWdCrBl f w cr -> performAction cr w ifa - | otherwise -> ([], Nothing) + | otherwise -> ([], mempty) DoActionIfElse ifa f elsea | doWdCrBl f w cr -> performAction cr w ifa | otherwise -> performAction cr w elsea DoActionWhileInterrupt repa f afta - | doWdCrBl f w cr -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta) + | doWdCrBl f w cr -> (fst $ performAction cr w repa, [DoActionWhileInterrupt repa f afta]) | otherwise -> performAction cr w afta - DoActions [] -> ([], Nothing) + DoActions [] -> ([], mempty) DoActions acs -> - let (imps, newAcs) = unzip $ map (performAction cr w) acs - in (concat imps, Just . DoActions $ catMaybes newAcs) - StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], Nothing) + let (imps, newAcs) = foldMap (performAction cr w) acs + in (imps, newAcs) + StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], mempty) PathTo p -> performPathTo cr w p TurnToPoint p -> performTurnToA cr p - LeadTarget p -> fromMaybe ([],Nothing) $ do - i <- cr ^? crIntention . targetCr . _Just + LeadTarget p -> fromMaybe ([], mempty) $ do + i <- cr ^? crIntention . targetCr . _Just tcr <- w ^? cWorld . lWorld . creatures . ix i - return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing) + return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], mempty) UseSelf f -> performAction cr w $ doCrAc f cr ArbitraryAction f -> performAction cr w (doCrWdAc f cr w) DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of - (imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac) - (imp, _) -> (sideImp ++ imp, Nothing) + (imp, [nxtac]) -> (sideImp ++ imp, [DoImpulsesAlongside sideImp nxtac]) + (imp, _) -> (sideImp ++ imp, mempty) DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac DoReplicatePartial _ 0 pac -> performAction cr w pac DoReplicatePartial startac t partac -> case performAction cr w partac of - (imps, Just nextac) -> (imps, Just $ DoReplicatePartial startac t nextac) - (imps, _) -> (imps, Just $ DoReplicatePartial startac (t -1) startac) - NoAction -> ([], Nothing) + (imps, [nextac]) -> (imps, [DoReplicatePartial startac t nextac]) + (imps, _) -> (imps, [DoReplicatePartial startac (t -1) startac]) + NoAction -> ([], mempty) --setMinInvSize :: Int -> Creature -> World -> World --setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n @@ -171,7 +170,7 @@ performAction cr w ac = case ac of dropExcept :: Creature -> Int -> World -> World dropExcept cr invid w = foldr (dropItem cr) w . IM.keys $ --- invid `IM.delete` _crInv cr + -- invid `IM.delete` _crInv cr invid `IM.delete` _unNIntMap (_crInv cr) -- why not a cid (Int)? @@ -180,8 +179,8 @@ dropItem cr invid w' = doanyitemdropeffect . maybeshiftseldown . copyItemToFloor (cr ^. crPos . _xy) itm -- . mayberemoveequip - . rmInvItem (_crID cr) (NInt invid) -- it is important - -- to do this before copying the item to the floor! + . rmInvItem (_crID cr) (NInt invid) -- it is important + -- to do this before copying the item to the floor! . soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) whiteNoiseFadeOutS Nothing $ w' where @@ -204,7 +203,7 @@ youDropItem w = fromMaybe w $ do <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap)) guard $ not $ w ^. cWorld . lWorld . lInvLock return $ case cr ^. crStance . posture of - Aiming {} -> throwItem w + Aiming{} -> throwItem w AtEase -> dropItem cr curpos w where cr = you w diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index c54f22f19..8e2665d8e 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} --{-# LANGUAGE TupleSections #-} module Dodge.Creature.Impulse (followImpulse) where @@ -21,7 +22,7 @@ import System.Random -- note SwitchToItem doesn't necessarily update the root item correctly followImpulse :: Int -> World -> Impulse -> World -followImpulse cid w imp = case imp of +followImpulse cid w = \case ImpulseNothing -> w RandomImpulse rimp -> let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w) @@ -41,7 +42,7 @@ followImpulse cid w imp = case imp of Melee cid' -> hitCr cid' $ crup - ( (crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos))) . (crType . meleeCooldown .~ 20) + ( crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) . (crType . meleeCooldown .~ 20) ) RandomTurn a -> let (aa, g) = rr a diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs index d0e052cbd..177d0b44e 100644 --- a/src/Dodge/Data/ActionPlan.hs +++ b/src/Dodge/Data/ActionPlan.hs @@ -138,9 +138,7 @@ data Action } | NoAction | StartSentinelPost - | UseSelf - { _useSelf :: CrAc - } + | UseSelf { _useSelf :: CrAc } | ArbitraryAction {_arbitraryAction :: CrWdAc} -- | Repeatedly perform impulses alongside a main action until the main action terminates | DoImpulsesAlongside diff --git a/tags b/tags index cc2684853..4db380408 100644 --- a/tags +++ b/tags @@ -932,7 +932,7 @@ Opaque src/Dodge/Data/Wall.hs 44;" C OpticScope src/Dodge/Data/Item/Scope.hs 14;" C OptionScreen src/Dodge/Data/Universe.hs 82;" C OptionScreenFlag src/Dodge/Data/Universe.hs 72;" t -OutAction src/Dodge/Creature/Action.hs 42;" t +OutAction src/Dodge/Creature/Action.hs 46;" t OutLink src/Dodge/Data/Room.hs 44;" C OutsideTerminal src/Dodge/Data/Input.hs 30;" C OutwardShockwave src/Dodge/Data/Shockwave.hs 14;" C @@ -2806,12 +2806,12 @@ chaseCritMv src/Dodge/Creature/ReaderUpdate.hs 120;" f chaseCritPerceptionUpdate src/Dodge/Creature/Perception.hs 32;" f chaseCritVocalization src/Dodge/Creature/ChaseCrit.hs 36;" f chasmSimpleMaze src/Dodge/Room/Tutorial.hs 180;" f -chasmTest src/Dodge/Creature/Update.hs 133;" f +chasmTest src/Dodge/Creature/Update.hs 132;" f chasmWallToSurface src/Dodge/Base/Collide.hs 120;" f checkCombineSelectionExists src/Dodge/DisplayInventory.hs 100;" f checkConnection src/Dodge/Inventory/Swap.hs 66;" f -checkDeath src/Dodge/Creature/Update.hs 71;" f -checkDeath' src/Dodge/Creature/Update.hs 74;" f +checkDeath src/Dodge/Creature/Update.hs 70;" f +checkDeath' src/Dodge/Creature/Update.hs 73;" f checkEndGame src/Dodge/Update.hs 768;" f checkErrorGL src/Shader/Compile.hs 255;" f checkFBO src/Framebuffer/Check.hs 6;" f @@ -2936,7 +2936,7 @@ copierItemUpdate src/Dodge/Creature/State.hs 131;" f copyItemToFloor src/Dodge/FloorItem.hs 14;" f corDoor src/Dodge/Room/Room.hs 385;" f cornerList src/Preload/Render.hs 198;" f -corpseOrGib src/Dodge/Creature/Update.hs 112;" f +corpseOrGib src/Dodge/Creature/Update.hs 111;" f corridor src/Dodge/Room/Corridor.hs 17;" f corridorBoss src/Dodge/LockAndKey.hs 133;" f corridorN src/Dodge/Room/Corridor.hs 52;" f @@ -2980,7 +2980,7 @@ crShape src/Dodge/Creature/Shape.hs 8;" f crSpring src/Dodge/Update.hs 867;" f crStratConMatches src/Dodge/Creature/Test.hs 80;" f crStrength src/Dodge/Creature/Statistics.hs 29;" f -crUpdate src/Dodge/Creature/Update.hs 64;" f +crUpdate src/Dodge/Creature/Update.hs 63;" f crUpdateInvidLocations src/Dodge/Inventory/Location.hs 66;" f crUpdateItemLocations src/Dodge/Inventory/Location.hs 48;" f crVocalizationSound src/Dodge/Creature/Vocalization.hs 13;" f @@ -3418,10 +3418,10 @@ drawWlIDs src/Dodge/Debug/Picture.hs 393;" f drawZoneCirc src/Dodge/Debug/Picture.hs 301;" f drawZoneCol src/Dodge/Debug/Picture.hs 149;" f drawZoneNearPointCursor src/Dodge/Debug/Picture.hs 294;" f -dropAll src/Dodge/Creature/Update.hs 130;" f -dropExcept src/Dodge/Creature/Action.hs 161;" f +dropAll src/Dodge/Creature/Update.hs 129;" f +dropExcept src/Dodge/Creature/Action.hs 166;" f dropInventoryPath src/Dodge/HeldUse.hs 1351;" f -dropItem src/Dodge/Creature/Action.hs 168;" f +dropItem src/Dodge/Creature/Action.hs 173;" f dropper src/Dodge/Item/Scope.hs 76;" f drumMag src/Dodge/Item/Ammo.hs 34;" f dsZoneSize src/Dodge/Zoning/Cloud.hs 42;" f @@ -3562,8 +3562,7 @@ foamSprayLoopS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 554;" f foldMTRS src/Dodge/Room/Tutorial.hs 58;" f foldPairs src/ListHelp.hs 37;" f foldrWhileArb src/ListHelp.hs 110;" f -followImpulse src/Dodge/Creature/Impulse.hs 30;" f -followImpulses src/Dodge/Creature/Impulse.hs 24;" f +followImpulse src/Dodge/Creature/Impulse.hs 23;" f foot1S src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 486;" f foot2S src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 510;" f foot3S src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 622;" f @@ -4392,11 +4391,11 @@ pedestalRoom src/Dodge/Room/Containing.hs 50;" f penThing src/Dodge/Bullet.hs 210;" f perMat src/MatrixHelper.hs 49;" f perceptionUpdate src/Dodge/Creature/Perception.hs 24;" f -performAction src/Dodge/Creature/Action.hs 88;" f -performActions src/Dodge/Creature/Action.hs 36;" f -performAimAt src/Dodge/Creature/Action.hs 44;" f -performPathTo src/Dodge/Creature/Action.hs 57;" f -performTurnToA src/Dodge/Creature/Action.hs 75;" f +performAction src/Dodge/Creature/Action.hs 93;" f +performActions src/Dodge/Creature/Action.hs 38;" f +performAimAt src/Dodge/Creature/Action.hs 48;" f +performPathTo src/Dodge/Creature/Action.hs 61;" f +performTurnToA src/Dodge/Creature/Action.hs 80;" f perspectiveMatrixb src/MatrixHelper.hs 11;" f pesNearCirc src/Dodge/Zoning/Pathing.hs 43;" f pesNearPoint src/Dodge/Zoning/Pathing.hs 33;" f @@ -4470,7 +4469,7 @@ pointerToItemID src/Dodge/Item/Location.hs 42;" f pointerYourRootItem src/Dodge/Item/Location.hs 33;" f pointerYourSelectedItem src/Dodge/Item/Location.hs 26;" f pointsToPoly src/Geometry/ConvexPoly.hs 37;" f -poisonSPic src/Dodge/Creature/Update.hs 126;" f +poisonSPic src/Dodge/Creature/Update.hs 125;" f poisonSprayer src/Dodge/Item/Held/SprayGuns.hs 17;" f poke34 src/Shader/Poke.hs 506;" f pokeArrayOff src/Shader/Poke.hs 517;" f @@ -4834,7 +4833,7 @@ scaleSH src/Shape.hs 269;" f scalp src/Dodge/Creature/Picture.hs 93;" f scancodeToHotkey src/Dodge/Creature/YourControl.hs 102;" f scodeToChar src/Dodge/ScodeToChar.hs 6;" f -scorchSPic src/Dodge/Creature/Update.hs 123;" f +scorchSPic src/Dodge/Creature/Update.hs 122;" f screenBox src/Dodge/Base/Window.hs 53;" f screenPolygon src/Dodge/Base/Window.hs 17;" f screenPolygonBord src/Dodge/Base/Window.hs 27;" f @@ -5233,7 +5232,7 @@ thingsHit src/Dodge/WorldEvent/ThingsHit.hs 36;" f thingsHitExceptCr src/Dodge/WorldEvent/ThingsHit.hs 119;" f thingsHitZ src/Dodge/WorldEvent/ThingsHit.hs 44;" f threeLineDecoration src/Dodge/Placement/TopDecoration.hs 61;" f -throwItem src/Dodge/Creature/Action.hs 204;" f +throwItem src/Dodge/Creature/Action.hs 209;" f tileTexCoords src/Tile.hs 11;" f tilesFromRooms src/Dodge/Layout.hs 192;" f tilesToLine src/Shader/AuxAddition.hs 66;" f @@ -5406,8 +5405,8 @@ updateCloud src/Dodge/Update.hs 798;" f updateClouds src/Dodge/Update.hs 669;" f updateCombinePositioning src/Dodge/DisplayInventory.hs 40;" f updateCombineSections src/Dodge/DisplayInventory.hs 47;" f -updateCreature src/Dodge/Creature/Update.hs 33;" f -updateCreature' src/Dodge/Creature/Update.hs 42;" f +updateCreature src/Dodge/Creature/Update.hs 32;" f +updateCreature' src/Dodge/Creature/Update.hs 41;" f updateCreatureGroups src/Dodge/Update.hs 537;" f updateCreatureSoundPositions src/Dodge/Update.hs 516;" f updateDebris src/Dodge/Update.hs 572;" f @@ -5464,7 +5463,7 @@ updatePastWorlds src/Dodge/Update.hs 424;" f updatePreload src/Preload/Update.hs 20;" f updateProjectile src/Dodge/Projectile/Update.hs 25;" f updateProp src/Dodge/Prop/Update.hs 11;" f -updatePulse src/Dodge/Creature/Update.hs 147;" f +updatePulse src/Dodge/Creature/Update.hs 146;" f updatePulseBall src/Dodge/Update.hs 449;" f updatePulseLaser src/Dodge/Update.hs 612;" f updatePulseLasers src/Dodge/Update.hs 444;" f @@ -5659,7 +5658,7 @@ yIntercepts' src/Dodge/Zoning/Base.hs 76;" f yV2 src/Geometry/Vector.hs 205;" f yellow src/Color.hs 17;" f you src/Dodge/Base/You.hs 13;" f -youDropItem src/Dodge/Creature/Action.hs 190;" f +youDropItem src/Dodge/Creature/Action.hs 195;" f yourAugmentedItem src/Dodge/Render/HUD.hs 238;" f yourControl src/Dodge/Creature/YourControl.hs 28;" f yourDefaultStrideLength src/Dodge/Default/Creature.hs 110;" f