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

Rename (indexed) particles to projectiles

Browse Source
This commit is contained in:
jgk
2021-03-23 14:03:00 +01:00
parent 941fef134d
commit 885fa4a67e
11 changed files with 245 additions and 251 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent.hs
+19 -59
View File
@@ -4,9 +4,11 @@ module Dodge.WorldEvent
, module Dodge.WorldEvent.Flash
, module Dodge.WorldEvent.ThingsHit
, module Dodge.WorldEvent.HelperParticle
, module Dodge.WorldEvent.Projectile
)
where
import Dodge.WorldEvent.Projectile
import Dodge.WorldEvent.Bullet
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit
@@ -25,7 +27,6 @@ import Control.Monad.State
import System.Random
import Data.Bifunctor
import Data.Maybe
import Data.Function
import Data.List
@@ -35,10 +36,10 @@ makeExplosionAt :: Point2 -> World -> World
makeExplosionAt p w = soundOnce grenadeBang
$ over tempLightSources ((:) $ tLightFade 20 150 intensityF p)
$ fs
$ over particles (IM.insert n exp)
$ over projectiles (IM.insert n exp)
w
where n = newParticleKey w
exp = Particle
exp = Projectile
{ _ptPos = p
, _ptStartPos = p
, _ptVel = (0,0)
@@ -66,11 +67,11 @@ makeExplosionAt p w = soundOnce grenadeBang
| otherwise = 1
explosionWaveDamage :: Int -> Point2 -> Int -> World -> World
explosionWaveDamage 0 p ptid = over particles (IM.delete ptid)
explosionWaveDamage 0 p ptid = over projectiles (IM.delete ptid)
explosionWaveDamage time p ptid
= set (particles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid)
= set (projectiles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid)
. shockWaveDamage p rad 20
. set (particles . ix ptid . ptPict) shockwavePic
. set (projectiles . ix ptid . ptPict) shockwavePic
. explosionFlashAt p
where shockwavePic = onLayer PtLayer $ uncurry translate p $ color (withAlpha 0.9 white)
$ thickCircle rad (thickness*2)
@@ -244,48 +245,7 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
noEff _ _ _ = id
type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
col = _btColor' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
((p,E3x2 wl):hs) | isJust (wl ^? blHP)
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
col = _btColor' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed pos vel levelInt maycid size time w
@@ -404,9 +364,9 @@ moveSmoke'' scal time p vel w pt
]
makeColorSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
makeColorSmokeAt col vel scal time p w = over particles (IM.insert n smP) w
makeColorSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
where n = newParticleKey w
smP = Particle
smP = Projectile
{ _ptPos = p
, _ptStartPos = p
, _ptVel = vel
@@ -418,22 +378,22 @@ makeColorSmokeAt col vel scal time p w = over particles (IM.insert n smP) w
moveColorSmoke :: Color -> Float -> Int -> Int -> World -> World
moveColorSmoke col scal time i w
| time > 0
= set (particles . ix i . ptPict) pic
. set (particles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
. set (particles . ix i . ptPos) newPos
= set (projectiles . ix i . ptPict) pic
. set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
. set (projectiles . ix i . ptPos) newPos
. setVel
$ w
| time > -50
= set (particles . ix i . ptPict) pi1
. set (particles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
. set (particles . ix i . ptPos) newPos
= set (projectiles . ix i . ptPict) pi1
. set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
. set (projectiles . ix i . ptPos) newPos
. setVel
$ w
| otherwise
= over particles (IM.delete i) w
where oldPos = _ptPos $ _particles w IM.! i
newPos = oldPos +.+ (_ptVel $ _particles w IM.! i)
setVel = over (particles . ix i . ptVel) $ (*.*) 0.99
= over projectiles (IM.delete i) w
where oldPos = _ptPos $ _projectiles w IM.! i
newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i)
setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99
pic = onLayer PtLayer $ uncurry translate newPos $ color col $ circleSolid $ (21 - fromIntegral time) * scal
pi1 = onLayer PtLayer $ uncurry translate newPos
$ color (withAlpha (1 + fromIntegral time /50) col)