Cleanup muzzle flare

This commit is contained in:
jgk
2021-03-22 14:36:20 +01:00
parent 506b0c4b8d
commit bc4aeef35e
5 changed files with 30 additions and 49 deletions
+8 -6
View File
@@ -489,8 +489,9 @@ spreadGun = defaultGun
, _wpFireRate = 20 , _wpFireRate = 20
, _wpFireState = 0 , _wpFireState = 0
, _wpFire = shootWithSound (fromIntegral shotgunSound) , _wpFire = shootWithSound (fromIntegral shotgunSound)
$ withRecoil 100 . withRecoil 100
$ spreadNumVelWthHiteff' spreadGunSpread 9 (30,0) 2 bulletEffect' . withMuzFlare
$ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 bulletEffect'
, _wpSpread = spreadGunSpread , _wpSpread = spreadGunSpread
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)]
@@ -531,8 +532,9 @@ multGun = defaultGun
, _wpFireRate = 20 , _wpFireRate = 20
, _wpFireState = 0 , _wpFireState = 0
, _wpFire = shootWithSound (fromIntegral shotgunSound) , _wpFire = shootWithSound (fromIntegral shotgunSound)
$ withRecoil 200 . withRecoil 200
$ numVelWthHitEff' 5 (50,0) 4 bulletEffect' . withMuzFlare
$ numVelWthHitEff 5 (50,0) 4 bulletEffect'
, _wpSpread = spreadGunSpread , _wpSpread = spreadGunSpread
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ multGunPic , _itFloorPict = onLayer FlItLayer $ multGunPic
@@ -905,13 +907,13 @@ moveFlame rotd w pt =
-- ((p,(E3x1 cr)):_) -> (damcr cr p $ smokeGen damcrs, Nothing) -- ((p,(E3x1 cr)):_) -> (damcr cr p $ smokeGen damcrs, Nothing)
((p,(E3x1 cr)):_) ((p,(E3x1 cr)):_)
-> (soundFrom Flame fireSound 2 500 -> (soundFrom Flame fireSound 2 500
$ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep) $ over worldEvents ((.) $ flameGlareAt ep)
damcrs damcrs
, mvPt') , mvPt')
(thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs, rfl wl p) (thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs, rfl wl p)
_ -> (soundFrom Flame fireSound 2 500 _ -> (soundFrom Flame fireSound 2 500
-- adding reflective glare is too intensive for this laptop -- adding reflective glare is too intensive for this laptop
$ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep) $ over worldEvents ((.) $ flameGlareAt ep)
damcrs damcrs
, mvPt) , mvPt)
where sp = _btPos' pt where sp = _btPos' pt
+1 -1
View File
@@ -28,7 +28,7 @@ bulHitCr' bt p cr w =
addDamageArmoured = over (creatures . ix cid . crState . crDamage) addDamageArmoured = over (creatures . ix cid . crState . crDamage)
(\dams -> mvDams ++ dams) (\dams -> mvDams ++ dams)
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0 hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
flashEff = over worldEvents ((.) $ flareAt red p) flashEff = over worldEvents ((.) $ flareAt' red 0.02 0.05 p)
bulVel = _btVel' bt bulVel = _btVel' bt
ck cid = (+.+) (crKnockBack cid *.* bulVel) ck cid = (+.+) (crKnockBack cid *.* bulVel)
crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid
+7 -11
View File
@@ -95,7 +95,7 @@ shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> am
withMuzFlare :: (Int -> World -> World) -> Int -> World -> World withMuzFlare :: (Int -> World -> World) -> Int -> World -> World
withMuzFlare f cid w = over tempLightSources (tLightAt 3 pos :) withMuzFlare f cid w = over tempLightSources (tLightAt 3 pos :)
. lowLightAt pos2 $ f cid w . muzFlareAt pos2 $ f cid w
where cr = _creatures w IM.! cid where cr = _creatures w IM.! cid
dir = _crDir cr dir = _crDir cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
@@ -157,32 +157,29 @@ torqueAfter torque feff cid w
rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopePos %~ rotateV rot . itAttachment . _Just . scopePos %~ rotateV rot
spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect -> Int -> World -> World spreadNumVelWthHiteff :: Float -> Int -> Point2 -> Float -> HitEffect -> Int -> World -> World
spreadNumVelWthHiteff' spread num vel wth eff cid w spreadNumVelWthHiteff spread num vel wth eff cid w
= over particles' (newbuls ++) = over particles' (newbuls ++)
$ flip (foldr muzFlareAt) poss
w w
where cr = _creatures w IM.! cid where cr = _creatures w IM.! cid
newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid)
pos (rotateV d vel) eff wth pos (rotateV d vel) eff wth
) poss dirs colids ) poss dirs colids
pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)) poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
$ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w $ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w
dirs = map ((+) (_crDir cr)) dirs = map ((+) (_crDir cr))
$ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..] $ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..]
$ randomRs (0,spread/5) (_randGen w) $ randomRs (0,spread/5) (_randGen w)
-- $ randomRs (0,spreadGunSpread/5) (_randGen w)
colids = take num $ randomRs (0,11) (_randGen w) colids = take num $ randomRs (0,11) (_randGen w)
numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect -> Int -> World -> World numVelWthHitEff :: Int -> Point2 -> Float -> HitEffect -> Int -> World -> World
numVelWthHitEff' num vel wth eff cid w numVelWthHitEff num vel wth eff cid w
= over particles' (newbuls ++) = over particles' (newbuls ++)
$ flip (foldr muzFlareAt) (take num poss)
w w
where cr = _creatures w IM.! cid where cr = _creatures w IM.! cid
newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid) newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid)
pos (rotateV d vel) eff wth) pos (rotateV d vel) eff wth
)
poss colids poss colids
d = _crDir cr d = _crDir cr
poss = map (\o -> o +.+ pos) offsets poss = map (\o -> o +.+ pos) offsets
@@ -190,4 +187,3 @@ numVelWthHitEff' num vel wth eff cid w
offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..] offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
colids = take num $ randomRs (0,11) (_randGen w) colids = take num $ randomRs (0,11) (_randGen w)
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+1 -1
View File
@@ -69,7 +69,7 @@ explosionWaveDamage time p ptid
= set (particles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid) = set (particles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid)
. shockWaveDamage p rad 20 . shockWaveDamage p rad 20
. set (particles . ix ptid . ptPict) shockwavePic . set (particles . ix ptid . ptPict) shockwavePic
. lowLightRadAt white 0.3 75 150 p . explosionFlashAt p
where shockwavePic = onLayer PtLayer $ uncurry translate p $ color (withAlpha 0.9 white) where shockwavePic = onLayer PtLayer $ uncurry translate p $ color (withAlpha 0.9 white)
$ thickCircle rad (thickness*2) $ thickCircle rad (thickness*2)
thickness = max 0 $ sqrt $ (fromIntegral time - 2) * 8 thickness = max 0 $ sqrt $ (fromIntegral time - 2) * 8
+13 -30
View File
@@ -11,9 +11,6 @@ import Geometry
import Control.Lens import Control.Lens
flareAt :: Color -> Point2 -> World -> World
flareAt c p = flareAt' c 0.02 0.5 p
flareAt' :: Color -> Float -> Float -> Point2 -> World -> World flareAt' :: Color -> Float -> Float -> Point2 -> World -> World
flareAt' col alphax alphay p flareAt' col alphax alphay p
= -- over particles' ((:) (flashColAt col alphax p)) = -- over particles' ((:) (flashColAt col alphax p))
@@ -21,17 +18,16 @@ flareAt' col alphax alphay p
lowLightColAt col alphay p lowLightColAt col alphay p
lowLightColAt :: Color -> Float -> Point2 -> World -> World lowLightColAt :: Color -> Float -> Point2 -> World -> World
lowLightColAt col alphay p w = foldr (lowLightColHit col alphay p) w ps lowLightColAt col alphay p w = foldr (lowLightWidthHit 10 5 col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad 20 30 where ps = map ((+.+) p) $ nRaysRad 20 30
lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
lowLightColHit :: Color -> Float -> Point2 -> Point2 -> World -> World lowLightWidthHit len wdth col alphay a b w
lowLightColHit col alphay a b w
= case thingsHitLongLine a b w of = case thingsHitLongLine a b w of
((p, E3x2 wall):_) ((p, E3x2 wall):_)
-> over particles' ((:) (wallGlareWidth 10 5 col alphay p wall)) w -> over particles' ((:) (wallGlareWidth len wdth col alphay p wall)) w
((p, E3x1 cr):_) ((p, E3x1 cr):_)
-> over particles' ((:) (crGlareCol col alphay p cr)) w -> over particles' ((:) (crGlareWidth wdth col alphay p cr)) w
_ -> w _ -> w
flashColAt :: Color -> Float -> Point2 -> Particle' flashColAt :: Color -> Float -> Point2 -> Particle'
@@ -45,9 +41,6 @@ flashColAt col alphax (x,y) =
, _ptUpdate' = ptTimer' 1 , _ptUpdate' = ptTimer' 1
} }
crGlareCol :: Color -> Float -> Point2 -> Creature -> Particle'
crGlareCol col alphay p cr = crGlareWidth 5 col alphay p cr
wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle' wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle'
wallGlareWidth len wdth col alphay p wl = wallGlareWidth len wdth col alphay p wl =
Particle' Particle'
@@ -85,7 +78,7 @@ flareWidth len wdth rad rays col ax ay p
flareRad :: Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World flareRad :: Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
flareRad rad rays col ax ay p flareRad rad rays col ax ay p
= over particles' ((:) (flashRadAt rad col ax p)) = over particles' ((:) (flashRadAt rad col ax p))
. lowLightRadAt col ay rays rad p . lowLightWidthAt 10 5 col ay rays rad p
flashRadAt :: Float -> Color -> Float -> Point2 -> Particle' flashRadAt :: Float -> Color -> Float -> Point2 -> Particle'
flashRadAt rad col alphax (x,y) = flashRadAt rad col alphax (x,y) =
@@ -102,23 +95,13 @@ 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 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 where ps = map ((+.+) p) $ nRaysRad rays rad
lowLightRadAt :: Color -> Float -> Int -> Float -> Point2 -> World -> World explosionFlashAt = lowLightWidthAt 10 5 white 0.3 75 150
lowLightRadAt col alphay rays rad p w = foldr (lowLightColHit col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad rays rad
flameGlareAt = lowLightWidthAt 10 5 orange 0.05 8 50
lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World
lowLightDirected col alpha a b angles w lowLightDirected col alpha a b angles w
= foldr (\angle w' -> lowLightColHit col alpha a (a +.+ rotateV angle b) w') w angles = foldr (\angle w' -> lowLightWidthHit 10 5 col alpha a (a +.+ rotateV angle b) w') w angles
lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
lowLightWidthHit len wdth col alphay a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlareWidth len wdth col alphay p wall)) w
((p, E3x1 cr):_)
-> over particles' ((:) (crGlareWidth wdth col alphay p cr)) w
_ -> w
muzFlareAt :: Point2 -> World -> World muzFlareAt :: Point2 -> World -> World
@@ -128,10 +111,10 @@ muzFlareAt p = over particles' ((:) (muzzleFlareAt p))
muzzleFlareAt :: Point2 -> Particle' muzzleFlareAt :: Point2 -> Particle'
muzzleFlareAt (x,y) = muzzleFlareAt (x,y) =
Particle' Particle'
{ _ptPict' = pictures { _ptPict' = setDepth 0
$ map (\i -> onLayer PtLayer $ color (withAlpha 0.02 white) $ translate x y $ circleSolid i . setLayer 1
) . translate x y
[20,25,30,35,40,45,50] $ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
, _ptUpdate' = ptTimer' 1 , _ptUpdate' = ptTimer' 1
} }