justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor basic explosion

Browse Source
This commit is contained in:
justin
2021-03-23 14:50:23 +01:00
parent 885fa4a67e
commit b13467053a
6 changed files with 32 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent.hs
+6 -39
View File
@@ -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