Refactor and improve flamelets

This commit is contained in:
jgk
2021-03-24 22:42:43 +01:00
parent baecb8e15a
commit bc5ad33652
4 changed files with 76 additions and 86 deletions
+6 -7
View File
@@ -94,18 +94,17 @@ reducePastDamage = over (crState . crPastDamage) rdpdam
| x > 0 = x - 1
| otherwise = 0
movementSideEff :: Creature -> World -> World
movementSideEff cr w
| hasJetPack
= case cr ^? crState . stance . carriage of
Just (Boosting v)
-> makeFlamelet (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
66
Nothing
1
-> makeFlameletTimed
(oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
Nothing
1
20
$ set randGen g
w
_ -> w
+4 -7
View File
@@ -130,7 +130,7 @@ autoFireMode = shootWithSound (fromIntegral autoGunSound)
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
$ destroyOnImpact bulIncCr' bulIncWall' bulHitFF'
singleFireMode = shootWithSound (fromIntegral autoGunSound)
. withRecoil 40
. torqueAfter 0.03
@@ -139,6 +139,7 @@ singleFireMode = shootWithSound (fromIntegral autoGunSound)
. withVelWthHiteff (50,0) 3
$ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
incMode :: Int -> World -> World
incMode _ w
= case newMode of
@@ -754,9 +755,7 @@ moveShell time i cid rot accel w
$ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ makeFlameletTimed oldPos
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
$ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos))
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
(0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
$ smokeGen
w
| time > -200 = case thingHit of
@@ -1394,9 +1393,7 @@ moveRemoteShell time i cid itid dir w
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ smokeGen
$ makeFlameletTimed oldPos
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
$ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos))
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
(0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
$ setScope
w
| time > -200 = case thingHit of
+2 -2
View File
@@ -106,7 +106,7 @@ bulIncCr' bt p cr w
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
v = evalState (randInCirc 1) $ _randGen w
incFlamelets = over worldEvents $ (.) (makeFlamelet p v (levLayer UPtLayer) Nothing 3)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20)
bulConCr' :: Particle' -> Point2 -> Creature -> World -> World
bulConCr' bt p cr w
@@ -175,7 +175,7 @@ bulIncWall' bt p wl w = damageBlocks wl
_ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
incFlamelets = over worldEvents $ (.) (makeFlamelet pOut reflectVel (levLayer UPtLayer) Nothing 3)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
bulConWall' :: Particle' -> Point2 -> Wall -> World -> World
bulConWall' bt p wl w = damageBlocks wl
+64 -70
View File
@@ -48,7 +48,7 @@ makeExplosionAt p w = soundOnce grenadeBang
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
sizes = randomRs (2,6) $ _randGen w
times = randomRs (20,25) $ _randGen w
mF q v size time = makeFlameletTimed q v (levLayer GloomLayer - 1) Nothing size time
mF q v size time = makeFlameletTimed q v Nothing size time
newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times
addFlames w = foldr ($) w newFs
pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y)
@@ -219,79 +219,73 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
noEff _ _ _ = id
makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed pos vel levelInt maycid size time w
makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed pos vel maycid size time w
= set randGen g $ over particles' ((:) theFlamelet) w
-- $ flareAt' white 0.01 0.1 pos w
where theFlamelet =
Pt' { _ptDraw = const blank
, _ptUpdate' = moveFlamelet levelInt rot
, _btVel' = vel
, _btColor' = red
, _btPos' = pos
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = time
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
Pt' { _ptDraw = drawFlamelet rot
, _ptUpdate' = moveFlamelet
, _btVel' = vel
, _btColor' = red
, _btPos' = pos
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = time
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
(rot ,g) = randomR (0,3) $ _randGen w
makeFlamelet :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> World -> World
makeFlamelet pos vel levelInt maycid size w = set randGen g $ over particles' ((:) theFlamelet) w
where theFlamelet =
Pt' { _ptDraw = const blank
, _ptUpdate' = moveFlamelet levelInt rot
, _btVel' = vel
, _btColor' = red
, _btPos' = pos
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = 20
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
(rot ,g) = randomR (0.5,1.5) $ _randGen w
moveFlamelet :: Int -> Float -> World -> Particle' -> (World, Maybe Particle')
moveFlamelet levelInt rot w pt =
case _btTimer' pt of
time | time <= 0 -> (w, Nothing)
| otherwise -> (damcrs, mvPt)
where sp = _btPos' pt
vel = _btVel' pt
ep = sp +.+ vel
size = _btWidth' pt
siz2 = size + 0.2
mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptDraw = const thepicture
, _btPassThrough' = Nothing
,_btVel' = 0.8 *.* vel}
damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
((:) $ Flaming 3 sp ep ep)
pic = onLayerL [levelInt,3] $ uncurry translate ep
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
white (dark red)
)
$ rotate (0 - ( 0.1 * fromIntegral time + rot))
$ scale sc sc
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
piu = onLayerL [levelInt,1] $ uncurry translate ep
$ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
$ scale s1 s1
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
glow = onLayerL [levelInt,0] $ uncurry translate ep
$ color (withAlpha 0.01 red)
$ circleSolid 30
sc = (*) 2 $ log $ 1 + fromIntegral time / 20
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
s2 = 0.5 * (sc + s1)
thepicture = pictures [pic , piu , pi2 , glow]
pi2 = onLayerL [levelInt,2] $ uncurry translate ep
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
orange (dark red)
)
$ rotate (0 - (rot + 0.2 * fromIntegral time))
$ scale s2 s2
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
drawFlamelet :: Float -> Particle' -> Picture
drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
where
sp = _btPos' pt
vel = _btVel' pt
ep = sp +.+ vel
size = _btWidth' pt
siz2 = size + 0.2
time = _btTimer' pt
glow = setDepth 0.336 $ uncurry translate ep
$ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30
piu = setDepth 0.334 $ uncurry translate ep
$ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
$ scale s1 s1
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
pi2 = setDepth 0.332 $ uncurry translate ep
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
orange (dark red)
)
$ rotate (0 - (rot + 0.2 * fromIntegral time))
$ scale s2 s2
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
pic = setDepth 0.33 $ uncurry translate ep
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
white (dark red)
)
$ rotate (0 - ( 0.1 * fromIntegral time + rot))
$ scale sc sc
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
sc = (*) 2 $ log $ 1 + fromIntegral time / 20
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
s2 = 0.5 * (sc + s1)
thepicture = pictures [pic , piu , pi2 , glow]
moveFlamelet :: World -> Particle' -> (World, Maybe Particle')
moveFlamelet w pt
| _btTimer' pt <= 0 = ( w, Nothing)
| otherwise = (damcrs, mvPt)
where
sp = _btPos' pt
vel = _btVel' pt
ep = sp +.+ vel
size = _btWidth' pt
mvPt = Just $ pt & btTimer' -~ 1
& btPos' .~ ep
& btPassThrough' .~ Nothing
& btVel' .~ 0.8 *.* vel
damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
((:) $ Flaming 3 sp ep ep)
doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World