118 lines
4.2 KiB
Haskell
118 lines
4.2 KiB
Haskell
{- | Flashes.
|
|
projected naming conventions: 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
|
|
-}
|
|
module Dodge.WorldEvent.Flash
|
|
where
|
|
import Dodge.Data
|
|
--import Dodge.Base
|
|
import Dodge.Picture
|
|
import Dodge.LightSources
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import Dodge.WorldEvent.HelperParticle
|
|
import Picture
|
|
import Geometry
|
|
|
|
import Data.Maybe (maybeToList)
|
|
import Control.Lens
|
|
|
|
glareAt :: Int -> Float -> Float -> Color -> Int -> Float -> Point2 -> World -> World
|
|
glareAt t len wdth col nrays rad p w = foldr (glareLine' t len wdth col p) w ps
|
|
where
|
|
ps = map (p +.+) $ nRaysRad nrays rad
|
|
|
|
{- White flash. -}
|
|
sparkFlashAt :: Point2 -> World -> World
|
|
sparkFlashAt =
|
|
glareAt 2 10 5 (withAlpha 0.05 white) 20 30
|
|
|
|
{- Red flash. -}
|
|
bloodFlashAt :: Point2 -> World -> World
|
|
bloodFlashAt p =
|
|
over particles (flashFlareAt red 0.4 p : )
|
|
. glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p
|
|
|
|
{- Cyan flash. -}
|
|
teslaGunFlashAt :: Point2 -> World -> World
|
|
teslaGunFlashAt p =
|
|
over particles (flashFlareAt cyan 0.3 p : )
|
|
. glareAt 2 10 5 (withAlpha 0.1 cyan) 20 30 p
|
|
|
|
{- Yellow flash. -}
|
|
laserGunFlashAt :: Point2 -> World -> World
|
|
laserGunFlashAt p =
|
|
over particles (flashFlareAt yellow 0.2 p : )
|
|
. glareAt 2 10 5 (withAlpha 0.05 yellow) 20 30 p
|
|
|
|
glareLine' :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> World
|
|
glareLine' t len wdth col a b w = w & particles %~ (maybeToList linePt ++)
|
|
where
|
|
linePt :: Maybe Particle
|
|
linePt = glareBetween t len wdth col a b w
|
|
|
|
glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> Maybe Particle
|
|
glareBetween 0 _ _ _ _ _ _ = Nothing
|
|
glareBetween t len wdth col a b w = Just $ Particle
|
|
{_ptDraw = const $ lowLightPic len wdth col (a,b) w
|
|
,_ptUpdate' = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w')
|
|
}
|
|
|
|
lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture
|
|
lowLightPic len wdth col (a,b) w = case thingsHit a b w of
|
|
((p, E3x2 wall):_)
|
|
-> setCol . lineOfThickness wdth $ [alongSegBy len p wa, alongSegBy len p wb]
|
|
where
|
|
(wa,wb) = _wlLine wall
|
|
((p, E3x1 cr):_)
|
|
-> setCol . uncurry translate cp . rotate (-0.25 * pi + argV (p -.- cp))
|
|
$ thickArc 0 (pi/2) (_crRad cr) wdth
|
|
where
|
|
cp = _crPos cr
|
|
_ -> blank
|
|
where setCol = color col . setDepth (-0.5) . setLayer 2
|
|
|
|
flashFlareAt :: Color -> Float -> Point2 -> Particle
|
|
flashFlareAt col alphax (x,y) = Particle
|
|
{ _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y
|
|
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
|
|
, _ptUpdate' = ptTimer' 1
|
|
}
|
|
|
|
explosionFlashAt :: Point2 -> World -> World
|
|
explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
|
|
. glareAt 20 10 5 (withAlpha 0.3 white) 75 150 p
|
|
where intensityFunc x
|
|
| x < 10 = 1 / (10 - fromIntegral x)
|
|
| otherwise = 1
|
|
|
|
flameGlareAt :: Point2 -> World -> World
|
|
flameGlareAt = glareAt 1 10 5 (withAlpha 0.05 orange) 8 40
|
|
|
|
lowLightDirected :: Color -> Point2 -> Point2 -> [Float] -> World -> World
|
|
lowLightDirected col a b angles w
|
|
= foldr (\angle w' -> glareLine' 2 10 5 col a (a +.+ rotateV angle b) w') w angles
|
|
|
|
|
|
muzzleFlashAt :: Point2 -> World -> World
|
|
muzzleFlashAt p = over particles (muzzleFlashPt p : )
|
|
. glareAt 2 10 5 (withAlpha 0.5 white) 20 30 p
|
|
|
|
muzzleFlashPt :: Point2 -> Particle
|
|
muzzleFlashPt (x,y) = Particle
|
|
{ _ptDraw = const $ setDepth 0
|
|
. setLayer 2
|
|
. translate x y
|
|
$ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
|
|
, _ptUpdate' = ptTimer' 1
|
|
}
|
|
|
|
laserScopeTargetGlow :: Color -> Point2 -> World -> World
|
|
laserScopeTargetGlow col = glareAt 2 3 1 (withAlpha 0.1 col) 15 5
|
|
|