From fe1ac8f5a4078b0ab176f557ad3dd38e5200524a Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 19 Jun 2025 22:55:46 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Creature/State.hs | 186 ++++++++++++-------------- src/Dodge/Creature/State/WalkCycle.hs | 33 ++--- 2 files changed, 101 insertions(+), 118 deletions(-) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index e1de33e50..78b0046ef 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -3,11 +3,7 @@ module Dodge.Creature.State ( doDamage, ) where -import Dodge.Data.Damage.Type -import Dodge.Item.BackgroundEffect -import Dodge.Item.MaxAmmo import Control.Applicative -import Dodge.HeldUse import Control.Monad import qualified Data.Map.Strict as M import Data.Maybe @@ -21,12 +17,16 @@ import Dodge.Creature.State.WalkCycle import Dodge.Creature.Test import Dodge.Damage import Dodge.Data.ComposedItem +import Dodge.Data.Damage.Type import Dodge.Data.DoubleTree import Dodge.Data.World import Dodge.DoubleTree import Dodge.Euse +import Dodge.HeldUse +import Dodge.Item.BackgroundEffect import Dodge.Item.Grammar import Dodge.Item.HeldOffset +import Dodge.Item.MaxAmmo import Dodge.Prop.Gib import Dodge.SoundLogic import Dodge.Targeting.Draw @@ -62,13 +62,14 @@ crUpdate f = foldCr [ doDamage -- these two , checkDeath -- must be in this order 24/7/22 - , footstepSideEffect + , updateWalkCycle , f --- , updateInv -- upInv must be called before invSideEff 22.05.23 - , invRootItemEffs + , -- , updateInv -- upInv must be called before invSideEff 22.05.23 + invRootItemEffs , invSideEff --- , equipmentEffects + -- , equipmentEffects ] + -- I have changed the ordering of item/equipment effects, which may have -- unforseen consequences, be aware @@ -79,36 +80,36 @@ checkDeath cr w & cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ [] | _crHP cr <= -200 = w - & dropByState cr -- the order of + & dropAll cr -- the order of & removecr -- these is important & stopSoundFrom (CrWeaponSound (_crID cr) 0) & addCrGibs cr - | _crHP cr > -200 && _crDeathTimer cr < 5 = + | _crHP cr > -200 && _crDeathTimer cr < 5 = w & cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ [] & cWorld . lWorld . creatures . ix (_crID cr) . crDeathTimer +~ 1 | otherwise = w - & dropByState cr -- the order of + & dropAll cr -- the order of & removecr -- these is important & stopSoundFrom (CrWeaponSound (_crID cr) 0) & corpseOrGib cr where removecr - | _crID cr == 0 = --- (cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature) - cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0 + | _crID cr == 0 = id + -- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0 -- hack to get around player creature being killed but left with more than 0 hp | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing -- could look at the amount of damage here (given by maxDamage) too corpseOrGib :: Creature -> World -> World corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of - Just CookingDamage -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic) - Just PoisonDamage -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic) + Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic) + Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic) Just PhysicalDamage | _crPastDamage cr > 200 -> addCrGibs cr - _ -> plNew (cWorld . lWorld . corpses) cpID thecorpse + _ -> addcorpse thecorpse where + addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype thecorpse = makeCorpse cr scorchSPic :: SPic -> SPic @@ -120,12 +121,8 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor) {- | Drop items according to the creature state. TODO make sure this doesn't mess up any ItemPosition -} -dropByState :: Creature -> World -> World -dropByState cr w = foldl' (flip (dropItem cr)) w $ IM.keys $ _crInv cr --- case cr ^. crState . csDropsOnDeath of --- DropAll -> IM.keys $ _crInv cr --- DropSpecific xs -> xs --- DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w) +dropAll :: Creature -> World -> World +dropAll cr w = foldl' (flip (dropItem cr)) w $ IM.keys $ _crInv cr doDamage :: Creature -> World -> World doDamage cr = applyPastDamages cr . applyCreatureDamage dams cr @@ -135,31 +132,21 @@ doDamage cr = applyPastDamages cr . applyCreatureDamage dams cr -- TODO generalise shake to arbitrary damage amounts applyPastDamages :: Creature -> World -> World applyPastDamages cr w - | _crPastDamage cr > 200 = - let (p, g) = runState (randInCirc 3) (_randGen w) - in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100)) - & randGen .~ g - | _crPastDamage cr > 20 = - let (p, g) = runState (randInCirc 2) (_randGen w) - in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10)) - & randGen .~ g - | _crPastDamage cr > 0 = - let (p, g) = runState (randInCirc 1) (_randGen w) - in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1)) - & randGen .~ g + | _crPastDamage cr > 200 = dojitter 3 100 + | _crPastDamage cr > 20 = dojitter 2 10 + | _crPastDamage cr > 0 = dojitter 1 1 | otherwise = w - --- a map updating all inventory items ---updateInv :: Creature -> World -> World ---updateInv cr =id ---updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv . each --- . itUse . heldDelay . warmTime %~ (max 0 . subtract 1) + where + dojitter x y = + let (p, g) = runState (randInCirc x) (_randGen w) + in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p + & cWorld . lWorld . creatures . ix (_crID cr) . crPastDamage -~ y + & randGen .~ g -- a loop going over all inventory items invSideEff :: Creature -> World -> World invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr where - --f it = maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv) f it = itBackgroundEffect it cr -- a loop going over all root inventory items @@ -176,8 +163,8 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of EQUIP WRIST_ECG | haspulse -> tryUseParent loc w _ -> w where - haspulse = - w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress + haspulse = + w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress == Just 0 itm = loc ^. locLDT . ldtValue . _1 @@ -197,57 +184,57 @@ tryUseParent loc w = fromMaybe w $ do trySynthBullet :: LocationLDT ItemLink ComposedItem -> World -> World trySynthBullet loc w = fromMaybe w $ do - i <- itm ^? itLocation . ilInvID - x <- itm ^? itUse . uaParams . apInt - if x < 100 - then do - bat <- loc ^? locLDT . ldtLeft . ix 0 . _2 . ldtValue . _1 - j <- bat ^? itLocation . ilInvID - y <- bat ^. itConsumables - guard $ y > 0 - return $ - w - & cWorld . lWorld . creatures - . ix 0 - . crInv - . ix i - . itUse - . uaParams - . apInt - +~ 1 - & cWorld . lWorld . creatures - . ix 0 - . crInv - . ix j - . itConsumables - . _Just - -~ 1 - else do - mag <- loc ^? locLdtContext . cldtParent . _1 - j <- mag ^? itLocation . ilInvID - y <- mag ^. itConsumables - ymax <- maxAmmo mag-- ^? itConsumables . magLoadStatus . iaMax - guard $ y < ymax - return $ - w - & cWorld . lWorld . creatures - . ix 0 - . crInv - . ix i - . itUse - . uaParams - . apInt - .~ 0 - & cWorld . lWorld . creatures - . ix 0 - . crInv - . ix j - . itConsumables - . _Just - +~ 1 + i <- itm ^? itLocation . ilInvID + x <- itm ^? itUse . uaParams . apInt + if x < 100 + then do + bat <- loc ^? locLDT . ldtLeft . ix 0 . _2 . ldtValue . _1 + j <- bat ^? itLocation . ilInvID + y <- bat ^. itConsumables + guard $ y > 0 + return $ + w + & cWorld . lWorld . creatures + . ix 0 + . crInv + . ix i + . itUse + . uaParams + . apInt + +~ 1 + & cWorld . lWorld . creatures + . ix 0 + . crInv + . ix j + . itConsumables + . _Just + -~ 1 + else do + mag <- loc ^? locLdtContext . cldtParent . _1 + j <- mag ^? itLocation . ilInvID + y <- mag ^. itConsumables + ymax <- maxAmmo mag + guard $ y < ymax + return $ + w + & cWorld . lWorld . creatures + . ix 0 + . crInv + . ix i + . itUse + . uaParams + . apInt + .~ 0 + & cWorld . lWorld . creatures + . ix 0 + . crInv + . ix j + . itConsumables + . _Just + +~ 1 where itm = loc ^. locLDT . ldtValue . _1 - + updateHeldRootItem :: Creature -> World -> World updateHeldRootItem cr = fromMaybe id $ do invid <- cr ^? crManipulation . manObject . imRootSelectedItem @@ -270,7 +257,7 @@ chainLinkOrientation :: ItemLink -> ComposedItem -> (Point3, Q.Quaternion Float) -chainLinkOrientation (p,q) par (ILink lt f) child = (p + Q.rotate q p1, q * q1) +chainLinkOrientation (p, q) par (ILink lt f) child = (p + Q.rotate q p1, q * q1) where (p1, q1) = f (par ^. _1) lt (child ^. _1) @@ -294,8 +281,10 @@ updateItemWithOrientation cr m loc@(LocLDT _ itmtree) w = drawARHUD :: LocationLDT ItemLink ComposedItem -> World -> World drawARHUD (LocLDT con _) w = fromMaybe w $ do itm <- con ^? cldtParent . _1 - return $ w & cWorld . lWorld . flares <>~ fold - (drawTargetingAR itm w <|> drawMapperAR itm w) + return $ + w & cWorld . lWorld . flares + <>~ fold + (drawTargetingAR itm w <|> drawMapperAR itm w) shineTargetLaser :: Creature -> @@ -397,8 +386,9 @@ updateItemTargeting tt cr itm w = case tt of setRBCreatureTargeting :: Creature -> World -> ItemTargeting -> ItemTargeting setRBCreatureTargeting cr w ituse - | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? itTgID . _Just) - && canSeeTarget = + | SDL.ButtonRight `M.member` _mouseButtons (_input w) + , isJust (ituse ^? itTgID . _Just) + , canSeeTarget = ituse & updatePos & itTgActive .~ True | otherwise = ituse & itTgID .~ fmap _crID newtarg & updatePos & itTgActive .~ False where diff --git a/src/Dodge/Creature/State/WalkCycle.hs b/src/Dodge/Creature/State/WalkCycle.hs index 395902b03..7e701f90e 100644 --- a/src/Dodge/Creature/State/WalkCycle.hs +++ b/src/Dodge/Creature/State/WalkCycle.hs @@ -1,8 +1,7 @@ {-# LANGUAGE LambdaCase #-} module Dodge.Creature.State.WalkCycle ( - -- updateWalkCycle, - footstepSideEffect, + updateWalkCycle, ) where import Control.Lens @@ -10,10 +9,18 @@ import Dodge.Data.World import Dodge.SoundLogic import Sound.Data -updateWalkCycle :: Stance -> Stance -updateWalkCycle s = case s ^. carriage of - Walking x ff | x > s ^. strideLength -> s & carriage .~ Walking 0 (normalGait ff) - _ -> s +updateWalkCycle :: Creature -> World -> World +updateWalkCycle cr = + case cr ^. crStance . carriage of + Walking x ff + | x > cr ^. crStance . strideLength -> + soundMultiFrom + [FootstepSound i | i <- [0 .. 10]] + (cr ^. crPos) + (chooseFootSound ff) + Nothing + . over (cWorld . lWorld . creatures . ix (cr ^. crID) . crStance . carriage) resetStride + _ -> id resetStride :: Carriage -> Carriage resetStride (Walking _ ff) = Walking 0 (normalGait ff) @@ -26,20 +33,6 @@ normalGait = \case RightForward -> LeftForward WasRightForward -> LeftForward -footstepSideEffect :: Creature -> World -> World -footstepSideEffect cr = - case cr ^. crStance . carriage of - Walking x ff - | x > cr ^. crStance . strideLength -> - soundMultiFrom - [FootstepSound i | i <- [0 .. 10]] - (cr ^. crPos) - (chooseFootSound ff) - Nothing - . - over (cWorld . lWorld . creatures . ix (cr ^. crID) . crStance . carriage) resetStride - _ -> id - chooseFootSound :: FootForward -> SoundID chooseFootSound LeftForward = foot1S chooseFootSound _ = foot2S