From 16078790149791824810ae6cb5231a0c3a0684d0 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 25 Mar 2022 14:04:13 +0000 Subject: [PATCH] Further cleanup --- src/Dodge/Combine/Combinations.hs | 12 +- src/Dodge/Creature/Damage.hs | 9 +- src/Dodge/Data.hs | 1 - src/Dodge/Item/Weapon/Bullet.hs | 6 +- src/Dodge/Particle/Bullet/DestroyDamage.hs | 40 ------- src/Dodge/Particle/Bullet/HitEffect.hs | 131 +++------------------ src/Dodge/Particle/Spark.hs | 13 +- src/Dodge/WorldEvent.hs | 2 - src/Dodge/WorldEvent/HitEffect.hs | 62 ---------- src/Dodge/WorldEvent/SpawnParticle.hs | 85 ++++--------- 10 files changed, 61 insertions(+), 300 deletions(-) delete mode 100644 src/Dodge/Particle/Bullet/DestroyDamage.hs delete mode 100644 src/Dodge/WorldEvent/HitEffect.hs diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index 90de1bce8..9d785a1e4 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -3,7 +3,8 @@ module Dodge.Combine.Combinations where import Geometry import Dodge.Data import Dodge.WorldEvent.SpawnParticle -import Dodge.Particle.Bullet.HitEffect +import Dodge.Particle.HitEffect.ExpireAndDamage +import Dodge.Particle.Damage import Dodge.Item.Equipment import Dodge.Item.Craftable import Dodge.Item.Weapon.BulletGuns @@ -114,11 +115,10 @@ moduleCombinations = ) , ( ModBullet , bulletWeapons --- , [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroySpawn incBall) - , [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroyDamage $ spawnBulDams incBall') - ,amod [BOUNCEMODULE] "+BOUNCE" (f $ bulletDestroyDamage bounceBulDams) - ,amod [STATICMODULE] "+STATIC" (f $ bulletDestroySpawn aStaticBall) - ,amod [CONCUSSMODULE] "+CONCUSS" (f $ bulletDestroySpawn concBall) + , [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ expireAndDamage $ spawnAtBulDams incBall) + ,amod [BOUNCEMODULE] "+BOUNCE" (f $ expireAndDamage bounceBulDams) + ,amod [STATICMODULE] "+STATIC" (f $ expireAndDamage $ spawnAtBulDams aStaticBall) + ,amod [CONCUSSMODULE] "+CONCUSS" (f $ expireAndDamage $ spawnAtBulDams concBall) ] ) , ( ModTarget diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 19652239f..e5a28cf6a 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -13,12 +13,13 @@ import Data.List defaultApplyDamage :: [Damage] -> Creature -> World -> World defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds' + & creatures . ix (_crID cr) %~ doPoisonDam where - (_,ds') = partition isPoison ds + (ps,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 -> Creature -> World -> World applyDamageEffect dm de cr w = case de of @@ -54,8 +55,6 @@ applyDamageEffect dm de cr w = case de of applyIndividualDamage :: Creature -> World -> Damage -> World applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm --- & applyDamageEffect dm (_dmEffect dm) - applyIndividualDamage' :: Creature -> World -> Damage -> World applyIndividualDamage' cr w dm = case _dmType dm of Piercing -> applyPiercingDamage cr dm w diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 56e9e167d..80b97350f 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1012,7 +1012,6 @@ data DamageEffect | TorqueDamage { _deTorque :: Float } | PushBackDamage {_dePushBack :: Point2 } | BounceBullet {_bulToBounce :: Particle} - | SparkBullet {_bulToSpark :: Particle} | DamageSpawn {_spawnFunc :: Either Creature Wall -> Damage -> State StdGen Particle} | NoDamageEffect diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index c54134e56..8d896d777 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -3,15 +3,17 @@ module Dodge.Item.Weapon.Bullet , hvBullet ) where import Dodge.Data -import Dodge.WorldEvent.HitEffect +import Dodge.Particle.HitEffect import Dodge.Particle.Bullet.HitEffect +import Dodge.Particle.Damage +import Dodge.Particle.HitEffect.ExpireAndDamage import Geometry.Data basicBullet :: AmmoType basicBullet = BulletAmmo { _amString = "BASIC" --, _amBulEff = destroyOnImpact bulHitCr bulHitWall - , _amBulEff = bulletDestroyDamage basicBulDams + , _amBulEff = expireAndDamage basicBulDams , _amBulWth = 2 , _amBulVel = V2 50 0 , _amBulTraj = BasicBulletTrajectory diff --git a/src/Dodge/Particle/Bullet/DestroyDamage.hs b/src/Dodge/Particle/Bullet/DestroyDamage.hs deleted file mode 100644 index 927b8bcda..000000000 --- a/src/Dodge/Particle/Bullet/DestroyDamage.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Dodge.Particle.Bullet.DestroyDamage - ( bulletDestroyDamage - ) where -import Dodge.Data -import Dodge.WorldEvent.HitEffect -import Dodge.Wall.Damage -import Geometry -import LensHelp - -bulletDestroyDamage :: DamageType - -> Int -- | damage amount - -> Particle - -> [(Point2, Either Creature Wall)] - -> World - -> (World, Maybe Particle) -bulletDestroyDamage dt amount = destroyOnImpact - (bulDamageCr dt amount) - (bulDamageWall dt amount) - -bulDamageCr :: DamageType -> Int - -> Particle -> Point2 -> Creature -> World -> World -bulDamageCr dt amount bt p cr w = w - & creatures . ix cid . crState . crDamage .:~ Damage dt amount sp p ep NoDamageEffect - where - cid = _crID cr - sp = head $ _ptTrail bt - ep = sp +.+ _ptVel bt - -bulDamageWall :: DamageType - -> Int - -> Particle - -> Point2 -- Impact point - -> Wall - -> World - -> World -bulDamageWall dt amount bt p wl w = w - & damageWall (Damage dt amount sp p ep NoDamageEffect) wl - where - ep = sp +.+ _ptVel bt - sp = head $ _ptTrail bt diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 1ca1bff54..4e81667d2 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -1,72 +1,17 @@ {- | Effects of bullets upon impact with walls or creatures. -} module Dodge.Particle.Bullet.HitEffect - ( basicBulDams - , bounceBulDams - , spawnBulDams - , hvBulHitCr + ( hvBulHitCr , hvBulHitWall - , bulletDestroySpawn - , bulletDestroyDamage - , bulBounceCr --- , bulBounceWall ) where import Dodge.Data import Dodge.Particle.Spark import Dodge.Wall.Damage -import Dodge.WorldEvent ---import Dodge.WorldEvent.HitEffect -import Dodge.RandomHelp import Dodge.Wall.Reflect import Geometry import Picture import LensHelp import System.Random -import Control.Monad.State - -spawnBulDams :: (Particle -> Either Creature Wall -> Damage -> State StdGen Particle) - -> Particle -> Point2 -> [Damage] -spawnBulDams thespawn bt p = - [ Damage Piercing 50 sp p ep (DamageSpawn $ thespawn bt) - , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel - ] - where - sp = head $ _ptTrail bt - bulVel = _ptVel bt - ep = sp +.+ bulVel - -basicBulDams :: Particle -> Point2 -> [Damage] -basicBulDams bt p = - [ Damage Piercing 100 sp p ep NoDamageEffect - , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel - ] - where - sp = head $ _ptTrail bt - bulVel = _ptVel bt - ep = sp +.+ bulVel - -bounceBulDams :: Particle -> Point2 -> [Damage] -bounceBulDams bt p = - [ Damage Piercing 80 sp p ep (BounceBullet bt) - , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel - ] - where - sp = head $ _ptTrail bt - bulVel = _ptVel bt - ep = sp +.+ bulVel - --- | Basic bullet hit creature effect. -bulBounceCr :: Particle -> Point2 -> Creature -> World -> World -bulBounceCr bt p cr = addDamage - where - sp = head $ _ptTrail bt - bulVel = _ptVel bt - ep = sp +.+ bulVel - mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ] - addDamage = creatures . ix cid . crState . crDamage .++~ - (Damage Piercing 100 sp p ep (BounceBullet bt) : mvDams) - cid = _crID cr - {- | Heavy bullet effects when hitting creature: piercing, blunt, twisting and pushback damage all applied. -} hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World @@ -87,62 +32,24 @@ damageGamut pdam bdam tor sp p ep = ,Damage PushDam 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp) ] -bulletDestroySpawn :: (Point2 -> State StdGen Particle) - -> Particle - -> [(Point2, Either Creature Wall)] - -> World - -> (World, Maybe Particle) -bulletDestroySpawn f = destroyOnImpact (bulDestroyCr f) (bulDestroyWall f) - -bulletDestroyDamage :: (Particle -> Point2 -> [Damage]) - -> Particle - -> [(Point2, Either Creature Wall)] - -> World - -> (World, Maybe Particle) -bulletDestroyDamage fdm bt hitThings w = case hitThings of - [] -> (w, mvPt bt) - ((p,Left cr):_) -> (creff cr p w, destroyAt p bt) - ((p,Right wl):_) -> (wleff wl p, destroyAt p bt) - where - creff cr p = addDamage - where - dams = fdm bt p - addDamage = creatures . ix cid . crState . crDamage .++~ dams - cid = _crID cr - wleff wl p = foldr (\d -> damageWall d wl) w dams - where - dams = fdm bt p - -{- | Create a particle when hitting a creature. -} -bulDestroyCr :: (Point2 -> State StdGen Particle) - -> Particle -> Point2 -> Creature -> World -> World -bulDestroyCr f bt p cr w = w - & instantParticles .:~ (pt & ptPos .~ p) - & creatures . ix cid . crState . crDamage .:~ Damage Piercing 60 sp p ep NoDamageEffect - & randGen .~ g - where - (pt,g) = randInCirc 1 >>= f & runState $ _randGen w - cid = _crID cr - sp = head $ _ptTrail bt - ep = sp +.+ _ptVel bt - -bulDestroyWall :: (Point2 -> State StdGen Particle) - -> Particle - -> Point2 -- Impact point - -> Wall - -> World - -> World -bulDestroyWall f bt p wl w = w - & damageWall (Damage Piercing 60 sp p ep NoDamageEffect) wl - & (instantParticles .:~ (pt & ptPos .~ pOut)) - & randGen .~ g - where - (pt,g) = runState (f reflectVel) (_randGen w) - ep = sp +.+ _ptVel bt - sp = head $ _ptTrail bt - pOut = p +.+ squashNormalizeV (sp -.- p) - wallV = uncurry (-.-) (_wlLine wl) - reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt) +--bulletDestroyDamage :: (Particle -> Point2 -> [Damage]) +-- -> Particle +-- -> [(Point2, Either Creature Wall)] +-- -> World +-- -> (World, Maybe Particle) +--bulletDestroyDamage fdm bt hitThings w = case hitThings of +-- [] -> (w, mvPt bt) +-- ((p,Left cr):_) -> (creff cr p w, destroyAt p bt) +-- ((p,Right wl):_) -> (wleff wl p, destroyAt p bt) +-- where +-- creff cr p = addDamage +-- where +-- dams = fdm bt p +-- addDamage = creatures . ix cid . crState . crDamage .++~ dams +-- cid = _crID cr +-- wleff wl p = foldr (`damageWall` wl) w dams +-- where +-- dams = fdm bt p hvBulHitWall :: Particle diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Particle/Spark.hs index 37945f6c1..8dec94d0d 100644 --- a/src/Dodge/Particle/Spark.hs +++ b/src/Dodge/Particle/Spark.hs @@ -3,12 +3,13 @@ module Dodge.Particle.Spark , colSparkRandDir , createBarrelSpark , randColDirTimeSpark - ) - where + ) where import Dodge.Data +import Dodge.Particle.HitEffect.ExpireAndDamage import Dodge.Particle.Bullet.Draw +import Dodge.Particle.Damage +--import Dodge.Particle.Bullet.HitEffect import Dodge.Particle.Bullet.Update -import Dodge.Particle.Bullet.DestroyDamage --import Dodge.WorldEvent.HitEffect import Color import Geometry @@ -29,7 +30,7 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt , _ptCrIgnore = maycid , _ptWidth = 1 , _ptTimer = time - , _ptHitEff = bulletDestroyDamage SparkDam 1 + , _ptHitEff = expireAndDamage basicSparkDams } colSpark :: Int -> Color -> Point2 -> Float -> World -> World colSpark = colSparkRandDir 0.7 @@ -60,7 +61,7 @@ randColDirTimeSpark randcol randdir randtime pos w = w , _ptCrIgnore = Nothing , _ptWidth = 1 , _ptTimer = time - , _ptHitEff = bulletDestroyDamage SparkDam 1 + , _ptHitEff = expireAndDamage basicSparkDams } colSparkRandDir :: Float -> Int -> Color -> Point2 -> Float -> World -> World @@ -80,5 +81,5 @@ colSparkRandDir randDir time col pos baseDir w = w , _ptCrIgnore = Nothing , _ptWidth = 1 , _ptTimer = time - , _ptHitEff = bulletDestroyDamage SparkDam 1 + , _ptHitEff = expireAndDamage basicSparkDams } diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 5cac16816..c2ef22233 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -2,13 +2,11 @@ module Dodge.WorldEvent ( module Dodge.WorldEvent.Flash , module Dodge.WorldEvent.ThingsHit , module Dodge.WorldEvent.Cloud - , module Dodge.WorldEvent.HitEffect , module Dodge.WorldEvent.Explosion , module Dodge.WorldEvent.SpawnParticle ) where import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud -import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.Explosion import Dodge.WorldEvent.SpawnParticle diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs deleted file mode 100644 index b8fb330c9..000000000 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ /dev/null @@ -1,62 +0,0 @@ -module Dodge.WorldEvent.HitEffect - ( destroyOnImpact - , penWalls - , mvPt - , destroyAt - ) where -import Dodge.Data -import Geometry -import LensHelp - -import Data.Bifunctor - -type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World -type HitWallEffect = Particle -> Point2 -> Wall -> World -> World - -destroyOnImpact - :: HitCreatureEffect - -> HitWallEffect - -> Particle - -> [(Point2, Either Creature Wall)] - -> World - -> (World, Maybe Particle) -destroyOnImpact crEff wlEff pt hitThings w = case hitThings of - [] -> ( w, mvPt pt) - ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt) - ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt) - -mvPt :: Particle -> Maybe Particle -mvPt pt = Just $ pt - & ptTrail %~ f - & ptTimer -~ 1 - & ptCrIgnore .~ Nothing - where - f trl = head trl +.+ _ptVel pt : trl - -destroyAt :: Point2 -> Particle -> Maybe Particle -destroyAt hitp pt = Just $ pt - & ptUpdate .~ killBulletUpdate - & ptTrail .:~ hitp - & ptTimer %~ (min 3 . subtract 1) - -killBulletUpdate :: World -> Particle -> (World,Maybe Particle) -killBulletUpdate w pt - | _ptTimer pt <= 0 = (w,Nothing) - | otherwise = (w - , Just $ pt & ptTimer -~ 1 - & ptTrail %~ (\(x:xs) -> x:x:xs) - ) - -penWalls - :: HitCreatureEffect - -> HitWallEffect - -> Particle - -> [(Point2, Either Creature Wall)] - -> World - -> (World, Maybe Particle) -penWalls crEff wlEff pt hitThings w = case hitThings of - [] -> ( w, mvPt pt) - ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt) - ((p,Right wl):hs) | _wlFireThrough wl - -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w - ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt) diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index fda38ec69..58cf3e968 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -4,22 +4,21 @@ module Dodge.WorldEvent.SpawnParticle , aFlameParticle , makeFlamelet , aStaticBall - , makeStaticBall , incBall - , incBall' , concBall ) where import Dodge.Data import Dodge.Base import Dodge.Zone -import Dodge.WorldEvent.HitEffect +import Dodge.Particle.HitEffect.ExpireAndDamage +import Dodge.Particle.Damage +--import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.Flash import Dodge.WorldEvent.Shockwave import Dodge.SoundLogic import Dodge.RandomHelp -import Dodge.Wall.Damage import Picture import Geometry import qualified IntMapHelp as IM @@ -43,7 +42,7 @@ aFlameParticle t pos vel maycid = PtZ , _ptCrIgnore = maycid , _ptWidth = 4 , _ptTimer = t - , _ptHitEff = damageBothTypeAmount Flaming 20 + , _ptHitEff = expireAndDamage $ simpleDam Flaming 20 , _ptZ = 20 } drawFlame @@ -127,28 +126,10 @@ incBall vel = do , _ptCrIgnore = Nothing , _ptWidth = 3 , _ptTimer = 20 - , _ptHitEff = damageBothTypeAmount Flaming 20 + , _ptHitEff = expireAndDamage $ simpleDam Flaming 20 , _ptZ = 20 } -incBall' :: Particle -> Either Creature Wall -> Damage -> State StdGen Particle -incBall' bt ecrwl dm = do - rot <- state $ randomR (0,3) - return PtZ - { _ptDraw = drawFlameletZ rot - , _ptUpdate = moveFlamelet - , _ptVel = vel - , _ptColor = red - , _ptPos = p - , _ptCrIgnore = Nothing - , _ptWidth = 3 - , _ptTimer = 20 - , _ptHitEff = damageBothTypeAmount Flaming 20 - , _ptZ = 20 - } - where - vel = 0 - p = _dmFrom dm concBall :: Point2 -> State g Particle concBall _ = return Shockwave { _ptDraw = drawShockwave @@ -173,34 +154,10 @@ aStaticBall vel = return PtZ , _ptCrIgnore = Nothing , _ptWidth = 3 , _ptTimer = 20 - , _ptHitEff = damageBothTypeAmount Electrical 20 + , _ptHitEff = expireAndDamage $ simpleDam Electrical 20 , _ptZ = 20 } - -makeStaticBall - :: Point2 -- ^ Position - -> Float -- ^ z position - -> Point2 -- ^ Velocity - -> Maybe Int -- ^ Ignore creature id - -> Float -- ^ Size - -> Int -- ^ Timer - -> World - -> World -makeStaticBall (V2 x y) z vel maycid size time w = w - & instantParticles .:~ PtZ - { _ptDraw = drawStaticBall - , _ptUpdate = moveStaticBall - , _ptVel = vel - , _ptColor = blue - , _ptPos = V2 x y - , _ptCrIgnore = maycid - , _ptWidth = size - , _ptTimer = time - , _ptHitEff = damageBothTypeAmount Electrical 20 - , _ptZ = z - } - makeFlamelet :: Point2 -- ^ Position -> Float -- ^ z position @@ -221,26 +178,26 @@ makeFlamelet (V2 x y) z vel maycid size time w = w , _ptCrIgnore = maycid , _ptWidth = size , _ptTimer = time - , _ptHitEff = damageBothTypeAmount Flaming 20 + , _ptHitEff = expireAndDamage $ simpleDam Flaming 20 , _ptZ = z } where (rot ,g) = randomR (0,3) $ _randGen w -damageBothTypeAmount :: DamageType - -> Int - -> Particle - -> [(Point2, Either Creature Wall)] - -> World - -> (World, Maybe Particle) -damageBothTypeAmount dt amount = destroyOnImpact - (\pt p cr -> creatures . ix (_crID cr) . crState . crDamage .:~ thedam pt p) - (\pt p -> damageWall (thedam pt p)) - where - thedam pt p = Damage dt amount sp p ep NoDamageEffect - where - sp = _ptPos pt - ep = sp +.+ _ptVel pt +--damageBothTypeAmount :: DamageType +-- -> Int +-- -> Particle +-- -> [(Point2, Either Creature Wall)] +-- -> World +-- -> (World, Maybe Particle) +--damageBothTypeAmount dt amount = destroyOnImpact +-- (\pt p cr -> creatures . ix (_crID cr) . crState . crDamage .:~ thedam pt p) +-- (\pt p -> damageWall (thedam pt p)) +-- where +-- thedam pt p = Damage dt amount sp p ep NoDamageEffect +-- where +-- sp = _ptPos pt +-- ep = sp +.+ _ptVel pt drawStaticBall :: Particle