{- | 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.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 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 = glareAt 2 3 1 (withAlpha 0.1 col) 15 5