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

Refactor flash lighting, improve laser scope lighting

Browse Source
This commit is contained in:
jgk
2021-03-23 19:36:59 +01:00
parent 3e2eaeece2
commit 021ff857fc
4 changed files with 25 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent/Flash.hs
+15 -36
View File
@@ -22,14 +22,18 @@ import Control.Lens
-- glow : continuous, potentially long, fading, slow changes in alpha
-- flicker : potentially long, moving, abrupt changes in alpha
glareAt :: Int -> Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
glareAt t len wdth col alphay nrays rad p w = foldr (glareLine t len wdth col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad nrays rad
sparkFlashAt :: Point2 -> World -> World
sparkFlashAt p =
over particles' ((:) (flashFlareAt white 0.2 p))
. glareAt 2 10 5 white 0.05 20 30 p
-- over particles' ((:) (flashFlareAt white 0.2 p))
glareAt 2 10 5 white 0.05 20 30 p
bloodFlashAt :: Point2 -> World -> World
bloodFlashAt p =
over particles' ((:) (flashFlareAt red 0.2 p))
over particles' ((:) (flashFlareAt red 0.4 p))
. glareAt 2 10 5 red 0.05 20 30 p
teslaGunFlashAt :: Point2 -> World -> World
@@ -42,9 +46,6 @@ laserGunFlashAt p =
over particles' ((:) (flashFlareAt yellow 0.2 p))
. glareAt 2 10 5 yellow 0.05 20 30 p
glareAt :: Int -> Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
glareAt t len wdth col alphay nrays rad p w = foldr (glareLine t len wdth col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad nrays rad
glareLine :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
glareLine t len wdth col alphay a b w = w & particles' %~ (maybeToList linePt ++)
@@ -70,7 +71,7 @@ lowLightPic len wdth col alphay a b w
$ thickArc 0 (pi/2) (_crRad cr) wdth
where cp = _crPos cr
_ -> blank
where setCol = color (withAlpha alphay col) . setDepth 0 . setLayer 1
where setCol = color (withAlpha alphay col) . setDepth (-0.5) . setLayer 2
flashFlareAt :: Color -> Float -> Point2 -> Particle'
flashFlareAt col alphax (x,y) =
@@ -80,27 +81,6 @@ flashFlareAt col alphax (x,y) =
, _ptUpdate' = ptTimer' 1
}
flareWidth :: Float -> Float -> Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
flareWidth len wdth rad rays col ax ay p
= over particles' ((:) (flashRadAt rad col ax p))
. glareAt 2 len wdth col ay rays rad p
flareRad :: Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
flareRad rad rays col ax ay p
= over particles' ((:) (flashRadAt rad col ax p))
. glareAt 2 10 5 col ay rays rad p
flashRadAt :: Float -> Color -> Float -> Point2 -> Particle'
flashRadAt rad col alphax (x,y) =
Particle'
{ _ptPict' = pictures $
map (\i -> onLayerL [levLayer PtLayer]
$ color (withAlpha alphax col) $ translate x y $ circleSolid i
)
[rad/5,2*rad/5,3*rad/5,4*rad/5,rad]
, _ptUpdate' = ptTimer' 1
}
explosionFlashAt :: Point2 -> World -> World
explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
. glareAt 20 10 5 white 0.3 75 150 p
@@ -115,21 +95,20 @@ lowLightDirected col alpha a b angles w
= foldr (\angle w' -> glareLine 2 10 5 col alpha a (a +.+ rotateV angle b) w') w angles
muzFlareAt :: Point2 -> World -> World
muzFlareAt p = over particles' ((:) (muzzleFlarePt p))
muzzleFlashAt :: Point2 -> World -> World
muzzleFlashAt p = over particles' ((:) (muzzleFlashPt p))
. glareAt 2 10 5 white 0.5 20 30 p
muzzleFlarePt :: Point2 -> Particle'
muzzleFlarePt (x,y) =
muzzleFlashPt :: Point2 -> Particle'
muzzleFlashPt (x,y) =
Particle'
{ _ptPict' = setDepth 0
. setLayer 1
. setLayer 2
. translate x y
$ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
, _ptUpdate' = ptTimer' 1
}
lowLightAt :: Point2 -> World -> World
lowLightAt p w = glareAt 2 10 5 white 0.5 20 30 p w
laserScopeTargetGlow :: Color -> Point2 -> World -> World
laserScopeTargetGlow col p = glareAt 2 3 1 col 0.1 15 5 p