From b13467053a199c322bb6b1f20503bdda9a9c5712 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 23 Mar 2021 14:50:23 +0100 Subject: [PATCH] Refactor basic explosion --- src/Dodge/Base.hs | 4 +-- src/Dodge/Debug.hs | 6 ++--- src/Dodge/Item/Weapon.hs | 20 +++++++-------- src/Dodge/Item/Weapon/Bullet.hs | 2 -- src/Dodge/WorldEvent.hs | 45 +++++---------------------------- src/Dodge/WorldEvent/Flash.hs | 16 ++++++++---- 6 files changed, 32 insertions(+), 61 deletions(-) diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 4c6ef9a05..fc0fef4be 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -483,8 +483,8 @@ newKey m = case IM.lookupMax m of Just (n,_) -> n+1 Nothing -> 0 -newParticleKey :: World -> Int -newParticleKey w = case IM.lookupMax (_projectiles w) of +newProjectileKey :: World -> Int +newProjectileKey w = case IM.lookupMax (_projectiles w) of Just (n,_) -> n+1 Nothing -> 0 newCrKey :: World -> Int diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 6331c4702..5ec296c47 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -13,7 +13,7 @@ import qualified Data.IntMap.Strict as IM drawCircleAtFor :: Point2 -> Int -> World -> World drawCircleAtFor p t w = - let n = newParticleKey w + let n = newProjectileKey w in over projectiles ( IM.insert n Projectile { _ptPos = p , _ptStartPos = p @@ -24,7 +24,7 @@ drawCircleAtFor p t w = } ) w drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World drawCircleAtForCol p t col w = - let n = newParticleKey w + let n = newProjectileKey w in over projectiles ( IM.insert n Projectile { _ptPos = p , _ptStartPos = p @@ -35,7 +35,7 @@ drawCircleAtForCol p t col w = } ) w drawLineForCol :: [Point2] -> Int -> Color -> World -> World drawLineForCol ps t col w = - let n = newParticleKey w + let n = newProjectileKey w in over projectiles ( IM.insert n Projectile { _ptPos = head ps , _ptStartPos = head ps diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index c89985fda..564f255cb 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -667,7 +667,7 @@ aTeslaArc' cid w = $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) $ set randGen g w where cr = (_creatures w IM.! cid) - i = newParticleKey w + i = newProjectileKey w pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) +.+ sideOffset *.* vNormal (unitVectorAtAngle dir) (sideOffset,g) = randomR (-5,5) $ _randGen w @@ -679,7 +679,7 @@ aLaser cid w = over particles' ( (:) (makeLaserAt phaseV pos dir (Just cid))) $ flareAt' yellow 0.02 0.05 (pos +.+ 5 *.* unitVectorAtAngle dir) w where cr = (_creatures w IM.! cid) - i = newParticleKey w + i = newProjectileKey w pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) dir = _crDir cr phaseV = fromMaybe 1 $ cr ^? crInv . ix j . itAttachment . _Just . itPhaseV @@ -691,7 +691,7 @@ aTractorBeam col cid w = set (creatures . ix cid . crInv . ix itRef . wpFire) (shoot $ aTractorBeam ((col + 1) `mod` 10)) $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w - where i = newParticleKey w + where i = newProjectileKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir) dir = _crDir cr @@ -701,7 +701,7 @@ aRocket :: Int -> World -> World aRocket cid w = soundOnce (fromIntegral launcherSound) $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w - where i = newParticleKey w + where i = newProjectileKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr @@ -877,7 +877,7 @@ aFlame a cid w pos2 = (0.5 *.* vel) +.+ _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) w1 = set randGen g w - i = newParticleKey w1 + i = newProjectileKey w1 -- vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir insertFlame = makeFlame pos vel (Just cid) -- . makeFlame pos2 vel (Just cid) @@ -1197,7 +1197,7 @@ withThickSmoke eff cid w = eff cid $ foldr ($) w smokeGen makeThinSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World makeThinSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w - where n = newParticleKey w + where n = newProjectileKey w smP = Projectile { _ptPos = p , _ptStartPos = p @@ -1400,7 +1400,7 @@ throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set ran } j = _crInvSel $ _creatures w IM.! n removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank - i = newParticleKey w + i = newProjectileKey w (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) @@ -1580,7 +1580,7 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire , _ptID = i , _ptUpdate = moveRemoteBomb itid 50 i } - i = newParticleKey w + i = newProjectileKey w -- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraPos w -.- yourPos) d = argV $ _mousePos w --(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w) @@ -1673,7 +1673,7 @@ moveTeslaArc p d i w = f2 0 = cyan f2 1 = azure f2 _ = white - sID = newParticleKey w + sID = newProjectileKey w q1 = last $ init ps' q2 = last ps' hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w @@ -1863,7 +1863,7 @@ forceFieldFire cid w = w -- (M.insert (_wpAmmoType item) newTotalA) w -- | emptyCondition = soundOnce 1 w -- | otherwise = w --- where i = newParticleKey w +-- where i = newProjectileKey w -- cr = (_creatures w IM.! n) -- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) -- dir = _crDir cr diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 49f3bb217..c305a4977 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -34,7 +34,6 @@ bulHitCr' bt p cr w = crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr cid = _crID cr - sID = newParticleKey w (d1,g) = randomR (-0.7,0.7) $ _randGen w (colID,_) = randomR (0,11) $ _randGen w hitEffect = addDamage @@ -208,7 +207,6 @@ hvBulHitWall' bt p x w = damageBlocks x = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall) _ -> w - sID = newParticleKey w cs = take 10 $ randomRs (0,11) $ _randGen w ds = randomRs (-0.7,0.7) $ _randGen w ts = randomRs (4,8) $ _randGen w diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 1a46ff0eb..9111fa89f 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -34,23 +34,13 @@ import qualified Data.IntMap.Strict as IM makeExplosionAt :: Point2 -> World -> World makeExplosionAt p w = soundOnce grenadeBang - $ over tempLightSources ((:) $ tLightFade 20 150 intensityF p) - $ fs - $ over projectiles (IM.insert n exp) + . addFlames + . explosionFlashAt p + $ makeShockwaveAt p 50 10 1 white w - where n = newParticleKey w - exp = Projectile - { _ptPos = p - , _ptStartPos = p - , _ptVel = (0,0) - , _ptPict = blank - , _ptID = n - , _ptUpdate = explosionWaveDamage 6 p n - } - fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w + where fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) - --fPs = map (pushAgainstWalls . (+.+) p . (*.*) 5) fPs' inversePushOut v = (15 - magV v) * 0.01 *.* v fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' @@ -58,25 +48,9 @@ makeExplosionAt p w = soundOnce grenadeBang times = randomRs (20,25) $ _randGen w mF q v size time = makeFlameletTimed q v (levLayer GloomLayer - 1) Nothing size time newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times - fs w = foldr ($) w newFs + addFlames w = foldr ($) w newFs pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y) $ collidePointWalls p q $ wallsNearPoint q w - fadeFac x | x > 10 = 0 - | otherwise = 1 - fromIntegral x / 10 - intensityF x | x < 10 = 1 / (10 - fromIntegral x) - | otherwise = 1 - -explosionWaveDamage :: Int -> Point2 -> Int -> World -> World -explosionWaveDamage 0 p ptid = over projectiles (IM.delete ptid) -explosionWaveDamage time p ptid - = set (projectiles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid) - . shockWaveDamage p rad 20 - . set (projectiles . ix ptid . ptPict) shockwavePic - . explosionFlashAt p - where shockwavePic = onLayer PtLayer $ uncurry translate p $ color (withAlpha 0.9 white) - $ thickCircle rad (thickness*2) - thickness = max 0 $ sqrt $ (fromIntegral time - 2) * 8 - rad = 40 - thickness shockWaveDamage :: Point2 -> Float -> Int -> World -> World shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w @@ -197,7 +171,6 @@ createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World createSpark time colid pos dir maycid w = over worldEvents ((.) $ ( over particles' ((:) spark) . flareAt' white 0.02 0.05 pos') - -- . lowLightAt' pos) ) w where spark = Bul' { _ptPict' = blank , _ptUpdate' = mvGenBullet' @@ -239,14 +212,8 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents where sp = head (_btTrail' bt) ep = sp +.+ _btVel' bt - - - - noEff _ _ _ = id - - makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World makeFlameletTimed pos vel levelInt maycid size time w = set randGen g $ over particles' ((:) theFlamelet) @@ -365,7 +332,7 @@ moveSmoke'' scal time p vel w pt makeColorSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World makeColorSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w - where n = newParticleKey w + where n = newProjectileKey w smP = Projectile { _ptPos = p , _ptStartPos = p diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 2e78c000a..2227debe9 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -2,6 +2,7 @@ module Dodge.WorldEvent.Flash where import Dodge.Data import Dodge.Base +import Dodge.LightSources import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.HelperParticle @@ -95,7 +96,12 @@ lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps where ps = map ((+.+) p) $ nRaysRad rays rad -explosionFlashAt = lowLightWidthAt 10 5 white 0.3 75 150 +explosionFlashAt :: Point2 -> World -> World +explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p) + . lowLightWidthAt 10 5 white 0.3 75 150 p + where intensityFunc x + | x < 10 = 1 / (10 - fromIntegral x) + | otherwise = 1 flameGlareAt = lowLightWidthAt 10 5 orange 0.05 8 50 @@ -105,11 +111,11 @@ lowLightDirected col alpha a b angles w muzFlareAt :: Point2 -> World -> World -muzFlareAt p = over particles' ((:) (muzzleFlareAt p)) - . lowLightAt p +muzFlareAt p = over particles' ((:) (muzzleFlarePt p)) + . lowLightWidthAt 10 5 white 0.5 20 30 p -muzzleFlareAt :: Point2 -> Particle' -muzzleFlareAt (x,y) = +muzzleFlarePt :: Point2 -> Particle' +muzzleFlarePt (x,y) = Particle' { _ptPict' = setDepth 0 . setLayer 1