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
-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