Refactor flash lighting, determine (projected) namespace
This commit is contained in:
+45
-114
@@ -13,20 +13,43 @@ import Geometry
|
||||
import Data.Maybe (maybeToList)
|
||||
|
||||
import Control.Lens
|
||||
-- projected naming: three base types of light:
|
||||
-- glare : "low lighting", draws lines around creatures and walls
|
||||
-- flare : coloured light drawn on top of picture in fixed shapes
|
||||
-- light : removal of shadows
|
||||
-- duration (subject to modification):
|
||||
-- flash : short, abrupt changes in alpha
|
||||
-- glow : continuous, potentially long, fading, slow changes in alpha
|
||||
-- flicker : potentially long, moving, abrupt changes in alpha
|
||||
|
||||
flareAt' :: Color -> Float -> Float -> Point2 -> World -> World
|
||||
flareAt' col alphax alphay p
|
||||
= -- over particles' ((:) (flashColAt col alphax p))
|
||||
-- .
|
||||
lowLightColAt col alphay p
|
||||
sparkFlashAt :: Point2 -> World -> World
|
||||
sparkFlashAt p =
|
||||
over particles' ((:) (flashFlareAt white 0.2 p))
|
||||
. glareAt 2 10 5 white 0.05 20 30 p
|
||||
|
||||
lowLightColAt :: Color -> Float -> Point2 -> World -> World
|
||||
lowLightColAt col alphay p w = foldr (lowLightWidthHit 10 5 col alphay p) w ps
|
||||
where ps = map ((+.+) p) $ nRaysRad 20 30
|
||||
bloodFlashAt :: Point2 -> World -> World
|
||||
bloodFlashAt p =
|
||||
over particles' ((:) (flashFlareAt red 0.2 p))
|
||||
. glareAt 2 10 5 red 0.05 20 30 p
|
||||
|
||||
lowLightWidthForHit :: Float -> Float -> Color -> Float -> Int -> Point2 -> Point2 -> World -> World
|
||||
lowLightWidthForHit len wdth col alphay t a b w = w & particles' %~ (maybeToList glareLine ++)
|
||||
where glareLine = glareBetween t len wdth col alphay a b w
|
||||
teslaGunFlashAt :: Point2 -> World -> World
|
||||
teslaGunFlashAt p =
|
||||
over particles' ((:) (flashFlareAt cyan 0.3 p))
|
||||
. glareAt 2 10 5 cyan 0.1 20 30 p
|
||||
|
||||
laserGunFlashAt :: Point2 -> World -> World
|
||||
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 ++)
|
||||
where linePt :: Maybe Particle'
|
||||
linePt = glareBetween t len wdth col alphay a b w
|
||||
|
||||
glareBetween :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> Maybe Particle'
|
||||
glareBetween 0 _ _ _ _ _ _ _ = Nothing
|
||||
@@ -49,92 +72,23 @@ lowLightPic len wdth col alphay a b w
|
||||
_ -> blank
|
||||
where setCol = color (withAlpha alphay col) . setDepth 0 . setLayer 1
|
||||
|
||||
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
|
||||
|
||||
flashColAt :: Color -> Float -> Point2 -> Particle'
|
||||
flashColAt col alphax (x,y) =
|
||||
flashFlareAt :: Color -> Float -> Point2 -> Particle'
|
||||
flashFlareAt col alphax (x,y) =
|
||||
Particle'
|
||||
{ _ptPict' = pictures $
|
||||
map (\i -> onLayerL [levLayer PtLayer]
|
||||
$ color (withAlpha alphax col) $ translate x y $ circleSolid i
|
||||
)
|
||||
[20,25,30,35,40,45,50]
|
||||
{ _ptPict' = setLayer 2 . setDepth (-0.9) . translate x y
|
||||
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
|
||||
, _ptUpdate' = ptTimer' 1
|
||||
}
|
||||
wallGlareFor :: Int -> Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle'
|
||||
wallGlareFor t len wdth col alphay p wl =
|
||||
Particle'
|
||||
{ _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l
|
||||
, _ptUpdate' = ptTimer' t
|
||||
}
|
||||
where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x]
|
||||
x = len *.* ( normalizeV $ a -.- b)
|
||||
(a:b:_) = _wlLine wl
|
||||
|
||||
wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle'
|
||||
wallGlareWidth len wdth col alphay p wl =
|
||||
Particle'
|
||||
{ _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l
|
||||
, _ptUpdate' = ptTimer' 1
|
||||
}
|
||||
where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x]
|
||||
x = len *.* ( normalizeV $ a -.- b)
|
||||
(a:b:_) = _wlLine wl
|
||||
|
||||
crGlareFor :: Int -> Float -> Color -> Float -> Point2 -> Creature -> Particle'
|
||||
crGlareFor t wdth col alphay p cr =
|
||||
Particle'
|
||||
{ _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp
|
||||
, _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w
|
||||
,_ptUpdate' = ptTimer' (t - 1)
|
||||
}
|
||||
)
|
||||
}
|
||||
where l x = uncurry translate x
|
||||
$ rotate (-0.25*pi + argV (p -.- x))
|
||||
$ color (withAlpha alphay col)
|
||||
$ thickArc 0 (pi/2) (_crRad cr) wdth
|
||||
cp = _crPos cr
|
||||
cid = _crID cr
|
||||
upp cid' w' = case w' ^? creatures . ix cid . crPos of
|
||||
Just y -> l y
|
||||
_ -> blank
|
||||
|
||||
crGlareWidth :: Float -> Color -> Float -> Point2 -> Creature -> Particle'
|
||||
crGlareWidth wdth col alphay p cr =
|
||||
Particle'
|
||||
{ _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp
|
||||
, _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w
|
||||
,_ptUpdate' = ptTimer' 0
|
||||
}
|
||||
)
|
||||
}
|
||||
where l x = uncurry translate x
|
||||
$ rotate (-0.25*pi + argV (p -.- x))
|
||||
$ color (withAlpha alphay col)
|
||||
$ thickArc 0 (pi/2) (_crRad cr) wdth
|
||||
cp = _crPos cr
|
||||
cid = _crID cr
|
||||
upp cid' w' = case w' ^? creatures . ix cid . crPos of
|
||||
Just y -> l y
|
||||
_ -> blank
|
||||
|
||||
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))
|
||||
. lowLightWidthAt len wdth col ay rays rad 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))
|
||||
. lowLightWidthAt 10 5 col ay rays rad p
|
||||
. glareAt 2 10 5 col ay rays rad p
|
||||
|
||||
flashRadAt :: Float -> Color -> Float -> Point2 -> Particle'
|
||||
flashRadAt rad col alphax (x,y) =
|
||||
@@ -147,33 +101,23 @@ flashRadAt rad col alphax (x,y) =
|
||||
, _ptUpdate' = ptTimer' 1
|
||||
}
|
||||
|
||||
lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
|
||||
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
|
||||
|
||||
lowLightAtFor :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> Int -> World -> World
|
||||
lowLightAtFor len wdth col alphay rays rad p t w
|
||||
= foldr (lowLightWidthForHit len wdth col alphay t p) w ps
|
||||
where ps = map ((+.+) p) $ nRaysRad rays rad
|
||||
|
||||
|
||||
explosionFlashAt :: Point2 -> World -> World
|
||||
explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
|
||||
. lowLightAtFor 10 5 white 0.3 75 150 p 20
|
||||
. glareAt 20 10 5 white 0.3 75 150 p
|
||||
where intensityFunc x
|
||||
| x < 10 = 1 / (10 - fromIntegral x)
|
||||
| otherwise = 1
|
||||
|
||||
flameGlareAt = lowLightWidthAt 10 5 orange 0.05 8 50
|
||||
flameGlareAt = glareAt 2 10 5 orange 0.05 8 50
|
||||
|
||||
lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World
|
||||
lowLightDirected col alpha a b angles w
|
||||
= foldr (\angle w' -> lowLightWidthHit 10 5 col alpha a (a +.+ rotateV angle b) w') w angles
|
||||
= 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))
|
||||
. lowLightWidthAt 10 5 white 0.5 20 30 p
|
||||
. glareAt 2 10 5 white 0.5 20 30 p
|
||||
|
||||
muzzleFlarePt :: Point2 -> Particle'
|
||||
muzzleFlarePt (x,y) =
|
||||
@@ -187,18 +131,5 @@ muzzleFlarePt (x,y) =
|
||||
|
||||
|
||||
lowLightAt :: Point2 -> World -> World
|
||||
lowLightAt p w = lowLightWidthAt 10 5 white 0.5 20 30 p w
|
||||
lowLightAt p w = glareAt 2 10 5 white 0.5 20 30 p w
|
||||
|
||||
lowLightAt' :: Point2 -> World -> World
|
||||
lowLightAt' p w = foldr (lowLightHit' p) w ps
|
||||
where ps = map ((+.+) p) $ nRaysRad 20 30
|
||||
|
||||
lowLightHit' :: Point2 -> Point2 -> World -> World
|
||||
lowLightHit' a b w
|
||||
= case thingsHitLongLine a b w of
|
||||
((p, E3x2 wall):_)
|
||||
-> over particles' ((:) (wallGlare' p wall)) w
|
||||
_ -> w
|
||||
|
||||
wallGlare' :: Point2 -> Wall -> Particle'
|
||||
wallGlare' p wl = wallGlareWidth 5 5 white 0.1 p wl
|
||||
|
||||
Reference in New Issue
Block a user