From 100f776dddc721eb5e65dc2a1375e80fb488f7ea Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 7 Apr 2022 21:39:39 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Creature.hs | 2 +- src/Dodge/Creature/ChaseCrit.hs | 6 +- src/Dodge/Creature/Impulse.hs | 24 ++++---- src/Dodge/Creature/LtAutoCrit.hs | 7 +-- src/Dodge/Creature/PistolCrit.hs | 6 +- src/Dodge/Creature/SpreadGunCrit.hs | 6 +- src/Dodge/Creature/State.hs | 81 +++++++------------------- src/Dodge/Creature/State/WalkCycle.hs | 1 - src/Dodge/Creature/Update.hs | 2 +- src/Dodge/Creature/YourControl.hs | 8 +-- src/Dodge/Placement/Instance/Turret.hs | 2 +- 11 files changed, 46 insertions(+), 99 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index e7c8ba931..00ae0d01b 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -149,7 +149,7 @@ startCr = defaultCreature , _crMvDir = pi/2 , _crID = 0 , _crPict = basicCrPict black - , _crUpdate = stateUpdate' yourControl + , _crUpdate = stateUpdate yourControl , _crRad = 10 , _crMass = 10 , _crHP = 1000 diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index e4df369cf..ee0c83dbe 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -5,12 +5,10 @@ module Dodge.Creature.ChaseCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture -import Dodge.Creature.ChainUpdates +import Dodge.Creature.Update import Dodge.Creature.ReaderUpdate -import Dodge.Creature.Impulse import Dodge.Creature.Action import Dodge.Creature.Perception -import Dodge.Creature.State import Dodge.Item.Consumable import Dodge.Picture.Layer import Dodge.SoundLogic @@ -33,7 +31,7 @@ smallChaseCrit = chaseCrit } chaseCrit :: Creature chaseCrit = defaultCreature - { _crUpdate = stateUpdate' $ impulsiveAI' $ chainCreatureUpdates + { _crUpdate = defaultImpulsive [ const doStrategyActions , performActions , const overrideMeleeCloseTarget diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index e958f7f9a..93932513e 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -1,10 +1,7 @@ {-# LANGUAGE TupleSections #-} module Dodge.Creature.Impulse - ( impulsiveAI - , impulsiveAI' - , followImpulses + ( impulsiveAI' , followThenClearImpulses - , followThenClearImpulses' ) where import Dodge.Data import Dodge.Creature.Vocalization @@ -18,6 +15,15 @@ import qualified Data.IntMap.Strict as IM import System.Random import Data.Bifunctor --import Data.Maybe +-- +impulsiveAIBeforeAfter + :: (World -> Creature -> Creature) + -> (World -> Creature -> Creature) + -> Creature -> World -> World +impulsiveAIBeforeAfter startup endup cr w = w' & creatures . ix (_crID cr) .~ endup w' cr' + where + w' = g w + (g,cr') = impulsiveAI startup cr w impulsiveAI' :: (World -> Creature -> Creature) -> Creature -> World -> World @@ -32,15 +38,9 @@ impulsiveAI -> (World -> World , Creature) impulsiveAI f cr w = followImpulses w $ f w cr -followThenClearImpulses' :: Creature -> World -> World -followThenClearImpulses' cr w = f w & creatures . ix (_crID cr) .~ cr' - where - (f,cr') = followThenClearImpulses w cr -followThenClearImpulses :: World -> Creature -> (World -> World, Creature) -followThenClearImpulses w = second f . followImpulses w - where - f = crActionPlan . crImpulse .~ [] +followThenClearImpulses :: Creature -> World -> World +followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . crImpulse .~ []) followImpulses :: World -> Creature -> (World -> World, Creature) followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr) diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 4aa26d14f..5f39d7515 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -4,8 +4,7 @@ module Dodge.Creature.LtAutoCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture -import Dodge.Creature.ChainUpdates -import Dodge.Creature.Impulse +import Dodge.Creature.Update import Dodge.Creature.Action import Dodge.Creature.Test import Dodge.Creature.Volition @@ -13,8 +12,6 @@ import Dodge.Creature.Strategy --import Dodge.Creature.ChooseTarget import Dodge.Creature.ReaderUpdate import Dodge.Creature.Perception -import Dodge.Creature.State ---import Dodge.Creature.State.Data import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Consumable import Geometry @@ -26,7 +23,7 @@ import Control.Lens ltAutoCrit :: Creature ltAutoCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate' $ impulsiveAI' $ chainCreatureUpdates + , _crUpdate = defaultImpulsive [ performActions , watchUpdateStrat [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index b396d1756..e710f393b 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -4,15 +4,13 @@ module Dodge.Creature.PistolCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture +import Dodge.Creature.Update import Dodge.Creature.Test -import Dodge.Creature.Impulse import Dodge.Creature.Action import Dodge.Creature.Volition import Dodge.Creature.Strategy import Dodge.Creature.ReaderUpdate -import Dodge.Creature.ChainUpdates import Dodge.Creature.Perception -import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Consumable @@ -29,7 +27,7 @@ import Control.Monad.State pistolCrit :: Creature pistolCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate' $ impulsiveAI' $ chainCreatureUpdates + , _crUpdate = defaultImpulsive [ performActions , watchUpdateStrat [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index a66a26f17..2cd26b6f8 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -4,15 +4,13 @@ module Dodge.Creature.SpreadGunCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture +import Dodge.Creature.Update import Dodge.Creature.Test -import Dodge.Creature.Impulse import Dodge.Creature.Action import Dodge.Creature.Volition import Dodge.Creature.Strategy import Dodge.Creature.ReaderUpdate -import Dodge.Creature.ChainUpdates import Dodge.Creature.Perception -import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Consumable @@ -27,7 +25,7 @@ import Control.Lens spreadGunCrit :: Creature spreadGunCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate' $ impulsiveAI' $ chainCreatureUpdates + , _crUpdate = defaultImpulsive [performActions ,watchUpdateStrat [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index d5a3c8e80..a52f70f55 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -1,9 +1,6 @@ module Dodge.Creature.State - ( stateUpdate' - , stateUpdateDamage + ( stateUpdate , doDamage - , clearDamage - , invSideEff ) where import Dodge.Data import Dodge.Hammer @@ -49,54 +46,39 @@ foldCr xs cr w = foldr ($ cr) w xs -- the creature before or after it has moved? -- at what point invSideEffects is applied wrt to when the creature moves -- may effect whether the shield moves correctly -stateUpdate' :: (Creature -> World -> World) -> Creature -> World -> World -stateUpdate' f = foldCr +stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World +stateUpdate f = foldCr [ checkDeath , doDamage , invSideEff , movementSideEff - , moveCrHammerUp - , stepReloading' - , updateMovement' + , internalUpdate , f ] checkDeath :: Creature -> World -> World -checkDeath cr - | _crHP cr < 1 = creatures . at (_crID cr) .~ Nothing -- TODO add corpse - | otherwise = id -moveCrHammerUp :: Creature -> World -> World -moveCrHammerUp cr = creatures . ix (_crID cr) . crHammerPosition %~ moveHammerUp - -stepReloading' :: Creature -> World -> World -stepReloading' cr = creatures . ix (_crID cr) %~ stepReloading - -updateMovement' :: Creature -> World -> World -updateMovement' cr = creatures . ix (_crID cr) %~ updateMovement - -stateUpdateDamage :: (Creature -> World -> World) - -> (Creature -> World -> (World -> World, Creature)) - -> Creature -> World -> World -stateUpdateDamage damageupdate u cr w = damageupdate cr - $ invSideEff upcr . movementSideEff cr . deathEff . f - $ w - & creatures . at (_crID cr) .~ (mvcrhammerup . stepReloading <$> crOrCorpse upcr) +checkDeath cr w + | _crHP cr > 0 = w + | otherwise = w + & creatures . at (_crID cr) .~ Nothing + & stopSoundFrom (CrWeaponSound (_crID cr) 0) + & over decorations addCorpse + & dropByState cr where - (f,upcr) = u (updateMovement cr) w - mvcrhammerup = crHammerPosition %~ moveHammerUp - crOrCorpse cr' - | cr' ^. crHP > 0 = Just cr' - | otherwise = Nothing - deathEff - | cr ^.crHP > 0 = id - | otherwise = stopSoundFrom (CrWeaponSound (_crID cr) 0) - . over decorations addCorpse - . dropByState cr addCorpse = IM.insertNewKey $ uncurryV translate (_crOldPos cr) $ rotate (_crDir cr) (_crCorpse cr) + +internalUpdate :: Creature -> World -> World +internalUpdate cr = creatures . ix (_crID cr) %~ + ( (crHammerPosition %~ moveHammerUp) + . stepReloading + . updateMovement + ) + -- | Drop items according to the creature state. +-- TODO make sure this doesn't mess up any ItemPosition dropByState :: Creature -> World -> World dropByState cr w = foldr (copyInvItemToFloor cr) w $ case cr ^. crState . crDropsOnDeath of DropAll -> IM.keys $ _crInv cr @@ -108,25 +90,13 @@ setOldPos cr = cr & crOldPos .~ _crPos cr & crOldDir .~ _crDir cr -clearDamage :: Creature -> World -> World -clearDamage cr = creatures . ix (_crID cr) . crState . crDamage .~ [] - doDamage :: Creature -> World -> World doDamage cr w = w & creatures . ix (_crID cr) . crState . crDamage .~ [] --- & creatures . ix (_crID cr) . crState . crPastDamage %~ advancePastDamages dams & _crApplyDamage cr dams cr where dams = _crDamage $ _crState cr ---advancePastDamages :: [Damage] -> V.Vector [Damage] -> V.Vector [Damage] ---advancePastDamages newDs v = f $ V.backpermute v bpVector --- where --- f = V.modify $ \v' -> MV.write v' 0 newDs - ---bpVector :: V.Vector Int ---bpVector = V.fromList $ 0 : [0 .. 18] - movementSideEff :: Creature -> World -> World movementSideEff cr w | hasJetPack = case cr ^? crStance . carriage of @@ -206,17 +176,6 @@ weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption o where cid = _crID cr ---weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of --- Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadType = PassiveReload stype,_wpReloadTime=rt,_wpReloadState=rs} } --- | rt == rs -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w --- | otherwise -> w --- Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadState = 0}} -> w --- Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadState = 1}} -> stopSoundFrom (CrReloadSound cid) w --- Just Weapon{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w --- _ -> w --- where --- cid = _crID cr - updateMovement :: Creature -> Creature updateMovement cr | isFrictionless cr = over crPos (+.+ momentum) $ setOldPos cr diff --git a/src/Dodge/Creature/State/WalkCycle.hs b/src/Dodge/Creature/State/WalkCycle.hs index 69c071562..b078d99a8 100644 --- a/src/Dodge/Creature/State/WalkCycle.hs +++ b/src/Dodge/Creature/State/WalkCycle.hs @@ -30,7 +30,6 @@ footstepSideEffect cr w = case cr ^? crStance . carriage of where maxStride = _strideLength (_crStance cr) - makeFootstepSound :: Int -> Int -> FootForward -> Point2 -> World -> World makeFootstepSound currentStride maxStride ff p | currentStride > maxStride = soundMultiFrom footor p (chooseFootSound ff) Nothing diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index c7395b035..2c9f90f4c 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -6,4 +6,4 @@ import Dodge.Creature.ChainUpdates defaultImpulsive :: [World -> Creature -> Creature] -> Creature -> World -> World -defaultImpulsive = stateUpdate' . impulsiveAI' . chainCreatureUpdates +defaultImpulsive = stateUpdate . impulsiveAI' . chainCreatureUpdates diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 588de8241..bd06ce72a 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -16,9 +16,8 @@ import Data.Maybe yourControl :: Creature -> World -> World yourControl cr w = w & updateUsingInput - & creatures . ix (_crID cr) %~ (mouseActionsCr (_mouseButtons w) . wasdWithAiming w speed) - where - speed = _mvSpeed $ _crMvType cr + & creatures . ix (_crID cr) %~ + (mouseActionsCr (_mouseButtons w) . wasdWithAiming w (_mvSpeed $ _crMvType cr)) {- | Turn key presses into creature movement. -} wasdWithAiming @@ -51,8 +50,7 @@ wasdWithAiming w speed cr isReloading = _posture (_crStance cr) == Reloading mouseDir = case cr ^? crInv . ix (_crInvSel cr) . itScope . scopePos of Just p -> normalizeAngle $ argV - $ p +.+ 2 / _cameraZoom w - *.* rotateV (_cameraRot w) (_mousePos w) + $ p +.+ 2 / _cameraZoom w *.* rotateV (_cameraRot w) (_mousePos w) _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w wasdM :: SDL.Scancode -> Point2 diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 93a77f184..72a86b9ed 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -77,7 +77,7 @@ updateTurret rotSpeed mc w & crRad .~ 1 & crDir .~ mcdir & crPict .~ (\cr _ _ -> drawCrEquipment cr) - & crUpdate .~ stateUpdate' followThenClearImpulses' + & crUpdate .~ stateUpdate followThenClearImpulses & crStance . posture .~ Aiming & crApplyDamage .~ applyNoDamage Just cid -> w'