Further cleanup

This commit is contained in:
2022-03-25 14:04:13 +00:00
parent a07647d89d
commit 1607879014
10 changed files with 61 additions and 300 deletions
+6 -6
View File
@@ -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
+4 -5
View File
@@ -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
-1
View File
@@ -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
+4 -2
View File
@@ -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
@@ -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
+19 -112
View File
@@ -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
+7 -6
View File
@@ -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
}
-2
View File
@@ -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
-62
View File
@@ -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)
+21 -64
View File
@@ -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