module Dodge.WorldEvent.Flash where import Dodge.Data import Dodge.Base import Dodge.LightSources import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.HelperParticle import Picture 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 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 sparkFlashAt :: Point2 -> World -> World sparkFlashAt p = glareAt 2 10 5 (withAlpha 0.05 white) 20 30 p bloodFlashAt :: Point2 -> World -> World bloodFlashAt p = over particles' ((:) (flashFlareAt red 0.4 p)) . glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p teslaGunFlashAt :: Point2 -> World -> World teslaGunFlashAt p = over particles' ((:) (flashFlareAt cyan 0.3 p)) . glareAt 2 10 5 (withAlpha 0.1 cyan) 20 30 p 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 thingsHitLongLine a b w of ((p, E3x2 wall):_) -> setCol . lineOfThickness wdth $ [alongLineBy len p wa, alongLineBy len p wb] where x = len *.* (normalizeV $ wa -.- wb) (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 = 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 p = glareAt 2 3 1 (withAlpha 0.1 col) 15 5 p