From a07647d89d4174ee04dbd4c54fa36653b06ac1ad Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 25 Mar 2022 12:00:35 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Creature/Damage.hs | 60 ++++++++++++++++----------------- src/Dodge/Creature/Inanimate.hs | 4 +-- src/Dodge/Creature/Lamp.hs | 2 +- src/Dodge/Creature/State.hs | 22 ++++++------ src/Dodge/Data.hs | 2 +- 5 files changed, 44 insertions(+), 46 deletions(-) diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 5b90ac39a..19652239f 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -8,31 +8,31 @@ import Geometry import LensHelp import Control.Monad.State -import System.Random +--import System.Random import Data.List -defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature) -defaultApplyDamage ds cr = over _2 doPoisonDam $ foldl' applyIndividualDamage (id,cr) ds' +defaultApplyDamage :: [Damage] -> Creature -> World -> World +defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds' where - (ps,ds') = partition isPoison ds + (_,ds') = partition isPoison ds isPoison Damage{_dmType=PoisonDam} = True isPoison _ = False - poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10 - doPoisonDam = crHP -~ poisonDam +-- poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10 +-- doPoisonDam = crHP -~ poisonDam -applyDamageEffect :: Damage -> DamageEffect -> (World->World,Creature) -> (World -> World, Creature) -applyDamageEffect dm de (f,cr) = case de of - PushDamage push pushexp pushRad -> (f, cr - & crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir))) ) +applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World +applyDamageEffect dm de cr w = case de of + PushDamage push pushexp pushRad -> w + & creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir) where pushAmount | dist (_crPos cr) fromDir == 0 = 0 | otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp - PushBackDamage pback -> (f, cr - & crPos %~ (+.+ ((1/_crMass cr) *.* pback )) - ) - TorqueDamage rot -> (f, cr & crDir +~ rot) - BounceBullet bt | crIsArmouredFrom p cr -> (f . (instantParticles .:~ bouncer), cr) -- TODO + PushBackDamage pback -> w + & creatures . ix (_crID cr) . crPos .+.+~ (1/_crMass cr) *.* pback + TorqueDamage rot -> w + & creatures . ix (_crID cr) . crDir +~ rot + BounceBullet bt | crIsArmouredFrom p cr -> w & instantParticles .:~ bouncer where bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt) @@ -41,32 +41,30 @@ applyDamageEffect dm de (f,cr) = case de of reflectVel = magV bulVel *.* newDir newDir = squashNormalizeV (p -.- _crPos cr) bulVel = _ptVel bt - DamageSpawn f -> (instantParticles .:~ thepart, cr) + BounceBullet _ -> w + DamageSpawn f -> w & instantParticles .:~ thepart + & randGen .~ g where - thepart = evalState (f (Left cr) dm) $ mkStdGen 0 + (thepart,g) = runState (f (Left cr) dm) $ _randGen w + NoDamageEffect -> w where fromDir = _dmFrom dm p = _dmAt dm -applyIndividualDamage :: (World -> World, Creature) -> Damage -> (World -> World, Creature) -applyIndividualDamage (f,cr) dm = applyDamageEffect dm (_dmEffect dm) (f . f', cr') - where - (f',cr') = applyIndividualDamage' (f,cr) dm +applyIndividualDamage :: Creature -> World -> Damage -> World +applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm -- & applyDamageEffect dm (_dmEffect dm) -applyIndividualDamage' :: (World -> World, Creature) -> Damage -> (World -> World, Creature) -applyIndividualDamage' (f,cr) dm = case _dmType dm of - Piercing -> applyPiercingDamage cr dm & _1 %~ (. f) - _ -> (f , newcr ) - where - newcr = cr - & crHP -~ _dmAmount dm +applyIndividualDamage' :: Creature -> World -> Damage -> World +applyIndividualDamage' cr w dm = case _dmType dm of + Piercing -> applyPiercingDamage cr dm w + _ -> w & creatures . ix (_crID cr) . crHP -~ _dmAmount dm -applyPiercingDamage :: Creature -> Damage -> (World -> World, Creature) +applyPiercingDamage :: Creature -> Damage -> World -> World applyPiercingDamage cr dm - | crIsArmouredFrom p cr = (colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p)) , cr) - | otherwise = (id, cr & crHP -~ _dmAmount dm) + | crIsArmouredFrom p cr = colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p)) + | otherwise = creatures . ix (_crID cr) . crHP -~ _dmAmount dm where p = _dmAt dm p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr) diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index ff70ed244..783c70b5e 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -55,11 +55,11 @@ explosiveBarrel = defaultInanimate {_crSpState = Barrel [] } , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] - ,_crApplyDamage = \_ c -> (id, c) + ,_crApplyDamage = \_ _ -> id } updateBarrel :: Creature -> World -> World updateBarrel cr - | _crHP cr > 0 = creatures . ix (_crID cr) %~ (snd . doDamage) + | _crHP cr > 0 = doDamage cr | otherwise = creatures . at (_crID cr) .~ Nothing -- should generate the sparks externally using new random generators diff --git a/src/Dodge/Creature/Lamp.hs b/src/Dodge/Creature/Lamp.hs index 271d21be8..03d4684aa 100644 --- a/src/Dodge/Creature/Lamp.hs +++ b/src/Dodge/Creature/Lamp.hs @@ -62,7 +62,7 @@ updateLamp h i cr w & creatures . at cid .~ Nothing | otherwise = w & lightSources . ix i . lsParam . lsPos .~ addZ h cpos - & creatures . ix cid %~ (snd . doDamage) + & doDamage cr where cpos = _crPos cr cid = _crID cr diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 7a4eee020..9a2ecad93 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -47,16 +47,15 @@ stateUpdate :: (Creature -> World -> (World -> World, Creature)) -> Creature -> World -> World stateUpdate = stateUpdateDamage doDamage -stateUpdateDamage :: (Creature -> (World -> World,Creature)) +stateUpdateDamage :: (Creature -> World -> World) -> (Creature -> World -> (World -> World, Creature)) -- -> CRUpdate -> Creature -> World -> World -stateUpdateDamage damageupdate u cr w = - mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f . g $ w - & creatures . at (_crID cr) .~ (stepReloading <$> crOrCorpse upcr') +stateUpdateDamage damageupdate u cr w = damageupdate cr $ + mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f $ w + & creatures . at (_crID cr) .~ (stepReloading <$> crOrCorpse upcr) where (f,upcr) = u (updateMovement cr) w - (g,upcr') = damageupdate upcr mvcrhammerup = creatures . ix (_crID cr) . crHammerPosition %~ moveHammerUp crOrCorpse cr' | cr' ^. crHP > 0 = Just cr' @@ -82,13 +81,14 @@ setOldPos cr = cr & crOldPos .~ _crPos cr & crOldDir .~ _crDir cr -clearDamage :: Creature -> (World-> World,Creature) -clearDamage cr = (id,cr&crState . crDamage .~ []) +clearDamage :: Creature -> World -> World +clearDamage cr = creatures . ix (_crID cr) . crState . crDamage .~ [] -doDamage :: Creature -> (World -> World, Creature) -doDamage cr = set (_2 . crState . crDamage) [] - . over (_2 . crState . crPastDamage) (advancePastDamages dams) - $ _crApplyDamage cr dams cr +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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index bc5394bc2..56e9e167d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -277,7 +277,7 @@ data Creature = Creature , _crLeftInvSel :: Maybe Int , _crState :: CreatureState , _crCorpse :: Picture - , _crApplyDamage :: [Damage] -> Creature -> (World -> World,Creature) + , _crApplyDamage :: [Damage] -> Creature -> World -> World , _crStance :: Stance , _crActionPlan :: ActionPlan , _crMeleeCooldown :: Int