module Dodge.WorldEvent
    ( module Dodge.WorldEvent
    , module Dodge.WorldEvent.Bullet
    , module Dodge.WorldEvent.Flash
    , module Dodge.WorldEvent.ThingsHit
    , module Dodge.WorldEvent.HelperParticle
    , module Dodge.WorldEvent.Projectile
    , module Dodge.WorldEvent.Cloud
    )
    where

import Dodge.WorldEvent.Projectile
import Dodge.WorldEvent.Bullet
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit
import Dodge.WorldEvent.HelperParticle
import Dodge.WorldEvent.Cloud
import Dodge.LightSources

import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.RandomHelp
import Geometry
import Picture

import Control.Lens
import Control.Monad.State

import System.Random

import Data.Maybe
import Data.Function
import Data.List
import qualified Data.IntMap.Strict as IM

makeExplosionAt :: Point2 -> World -> World
makeExplosionAt p w = soundOnce grenadeBang 
                        . addFlames 
                        . explosionFlashAt p
                        $ makeShockwaveAt p 50 10 1 white
                            w
    where fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w
          fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w
          fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) 
                    fPs'
          inversePushOut v = (15 - magV v) * 0.01 *.* v
          fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
          sizes = randomRs (2,6) $ _randGen w
          times = randomRs (20,25) $ _randGen w
          mF q v size time = makeFlameletTimed q v (levLayer GloomLayer - 1) Nothing size time
          newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times
          addFlames w = foldr ($) w newFs
          pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y) 
                                           $ collidePointWalls p q $ wallsNearPoint q w

shockWaveDamage :: Point2 -> Float -> Int -> World -> World
shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w
    where f cr | dist (_crPos cr) p < rad + _crRad cr = over (crState . crDamage) 
                                                             ((:) $ Concussive amount p 2 0.5 rad) cr
               | otherwise                            = cr
          hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
          damageBlocks wall w
            = case wall ^? blHP of 
                Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - (div amount 2))) 
                                 w 
                                 (_blIDs wall)
                _ -> w

makeShockwaveAt :: Point2 -> Float -> Int -> Float -> Color
                 -> World -> World
makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave)
    where theShockwave = shockwaveAt p rad dam push col 10

shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle'
shockwaveAt p rad dam push col maxtime
    = Shockwave'
            { _ptPict'      = blank
            , _ptUpdate'    = mvShockwave'
            , _btColor'     = col
            , _btPos'       = p
            , _btRad'       = rad
            , _btDam'       = dam
            , _btPush'      = push
            , _btMaxTime'   = maxtime
            , _btTimer'     = maxtime
            }

mvShockwave' :: World -> Particle' -> (World, Maybe Particle')
mvShockwave' w pt 
    | _btTimer' pt <= 0 = (w, Nothing)
    | otherwise
        = (dams w , Just $ set btTimer' (t - 1) $ set ptPict' pic pt)
    where r    = _btRad' pt
          p    = _btPos' pt
          push = _btPush' pt
          dam  = _btDam' pt
          t    = _btTimer' pt
          tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
          pic = onLayer PtLayer $ uncurry translate p 
                                $ color (_btColor' pt) $ thickCircle rad thickness
          rad = r - (3/4) * r * tFraction
          thickness = tFraction**2 * r 
          dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
          hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
          damageBlocks wall w
            = case wall ^? blHP of 
                Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) 
                                 w 
                                 (_blIDs wall)
                _ -> w
          damCr cr | dist (_crPos cr) p < rad + _crRad cr 
                                = over (crState . crDamage) 
                                       ((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)))
                                       cr
                   | otherwise  = cr
moveShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
moveShockWave 0 _ _ _    _       w _  = (w, Nothing)
moveShockWave t p r push pushexp w pt 
    = (dams w, Just $ newupdate $ newpic pt )
    where newupdate = set ptUpdate' $ moveShockWave (t-1) p r push pushexp
          newpic = set ptPict' (onLayer PtLayer $ uncurry translate p 
                                $ color cyan $ thickCircle rad thickness)
          rad = r - (3/40) * r * fromIntegral t
          thickness = (fromIntegral t)**2 * rad / 40
          dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
          hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
          damageBlocks wall w
            = case wall ^? blHP of 
                Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) 
                                 w 
                                 (_blIDs wall)
                _ -> w
          damCr cr | dist (_crPos cr) p < rad + _crRad cr 
                                = over (crState . crDamage) 
                                       ((:) $ PushDam 1 (25 *.* safeNormalizeV (_crPos cr -.- p)))
                                       cr
                   | otherwise  = cr

inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World
inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave)
    where theShockwave 
            = Particle' 
                { _ptPict' = blank
                , _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
                }
moveInverseShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
moveInverseShockWave 0 _ _ _    _       w _  = (w, Nothing)
moveInverseShockWave t p r push pushexp w pt 
    = (dams w, Just $ newupdate $ newpic pt )
    where newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp
          newpic = set ptPict' (onLayer PtLayer $ uncurry translate p 
                                $ color cyan $ thickCircle rad thickness)
          rad = r - (4/40) * r * fromIntegral (10 - t)
          thickness = (fromIntegral (10 - t))**2 * rad / 40
          dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
          hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
          damageBlocks wall w
            = case wall ^? blHP of 
                Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) 
                                 w 
                                 (_blIDs wall)
                _ -> w
          damCr cr | dist (_crPos cr) p < rad + _crRad cr 
                                = over (crState . crDamage) 
                                       ((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))
                                       cr
                   | otherwise  = cr
    
-- if the spark is created by another Particle', it cannot be directly added to
-- the list, hence the redirect through worldEvents
createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
createSpark time colid pos dir maycid w = over worldEvents 
                                        ((.) $ ( over particles' ((:) spark) 
--                                               . flareAt' white 0.02 0.05 pos')
                                               . sparkFlashAt pos')
                                        ) w
    where spark = Bul'  { _ptPict' = blank
                        , _ptUpdate' = mvGenBullet'
                        , _btVel' = rotateV dir (5,0)
                        , _btColor' = numColor colid
                        , _btTrail' = [pos]
                        , _btPassThrough' = maycid
                        , _btWidth' = 1
                        , _btTimer' = time
                        , _btHitEffect' = destroyOnImpact sparkEff noEff noEff
                        }
          x = fst $ randomR (0,20) $ _randGen w
          pos' = pos +.+ rotateV dir (x,0)
          sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
                                  ((:) $ SparkDam 1 sp p ep)
            where sp = head (_btTrail' bt)
                  ep = sp +.+ _btVel' bt

createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
createBarrelSpark time colid pos dir maycid w = over worldEvents 
                                        ((.) $ ( over particles' ((:) spark) 
                                               . sparkFlashAt pos')
                                        ) w
    where spark = Bul'  { _ptPict' = blank
                        , _ptUpdate' = mvGenBullet'
                        , _btVel' = rotateV dir (5,0)
                        , _btColor' = numColor colid
                        , _btTrail' = [pos]
                        , _btPassThrough' = maycid
                        , _btWidth' = 1
                        , _btTimer' = time
                        , _btHitEffect' = destroyOnImpact sparkEff noEff noEff
                        }
          x = fst $ randomR (0,20) $ _randGen w
          pos' = pos +.+ rotateV dir (x,0)
          sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
                                  ((:) $ SparkDam 1 sp p ep)
            where sp = head (_btTrail' bt)
                  ep = sp +.+ _btVel' bt

noEff _ _ _ = id

makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed  pos vel levelInt maycid size time w
    = set randGen g $ over particles' ((:) theFlamelet) w
--        $ flareAt' white 0.01 0.1 pos w
    where   theFlamelet =
                Pt' { _ptPict'         = blank
                     , _ptUpdate'      = moveFlamelet levelInt rot
                     , _btVel'         = vel
                     , _btColor'       = red
                     , _btPos'         = pos
                     , _btPassThrough' = maycid
                     , _btWidth'       = size
                     , _btTimer'       = time
                     , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff noEff
                     }
            (rot ,g) = randomR (0,3) $ _randGen w

makeFlamelet :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> World -> World
makeFlamelet pos vel levelInt maycid size w = set randGen g $ over particles' ((:) theFlamelet) w
    where   theFlamelet =
                Pt' { _ptPict'         = blank
                     , _ptUpdate'      = moveFlamelet levelInt rot
                     , _btVel'         = vel
                     , _btColor'       = red
                     , _btPos'         = pos
                     , _btPassThrough' = maycid
                     , _btWidth'       = size
                     , _btTimer'       = 20
                     , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff noEff
                     }
            (rot ,g) = randomR (0.5,1.5) $ _randGen w
moveFlamelet :: Int -> Float -> World -> Particle' -> (World, Maybe Particle')
moveFlamelet levelInt rot w pt = 
    case _btTimer' pt of 
      time | time <= 0 -> (w, Nothing)
           | otherwise -> (damcrs, mvPt)
        where   sp = _btPos' pt
                vel = _btVel' pt
                ep = sp +.+ vel
                size = _btWidth' pt
                siz2 = size + 0.2
                mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepicture
                                 , _btPassThrough' = Nothing
                                 ,_btVel' = 0.8 *.* vel}
                damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
                closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
                dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
                                ((:) $ Flaming 3 sp ep ep)
                pic = onLayerL [levelInt,3] $ uncurry translate ep
                              $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                                                 white                           (dark red)
                                      )
                              $ rotate (0 - ( 0.1 * fromIntegral time + rot))
                              $ scale sc sc
                              $ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
                piu = onLayerL [levelInt,1] $  uncurry translate ep 
                           $ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
                           $ scale s1 s1
                           $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
                glow = onLayerL [levelInt,0] $ uncurry translate ep
                            $ color (withAlpha 0.01 red)
                            $ circleSolid 30
                sc = (*) 2 $ log $ 1 + fromIntegral time / 20
                s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
                s2 = 0.5 * (sc + s1)
                thepicture = pictures [pic , piu , pi2 , glow]
                pi2 = onLayerL [levelInt,2] $ uncurry translate ep
                           $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                                              orange                          (dark red)
                                      )
                           $ rotate (0 - (rot + 0.2 * fromIntegral time))
                           $ scale s2 s2
                           $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
                

doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World
doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
                                 ((:) $ Flaming amount sp p ep)
        where sp = _btPos' pt
              ep = sp +.+ _btVel' pt

makeSmokeAt'' :: Point2 -> Float -> Int -> Point2 -> World -> World
makeSmokeAt'' vel scal time p w = over particles' ((:) smokeP) w
    where smokeP = Particle'
                     --{ _ptPict' = onLayerL [levLayer PtLayer - 1] $ uncurry translate p $ color black $ circleSolid 1
                     { _ptPict' = onLayerL [levLayer PtLayer ] $ uncurry translate p $ color black $ circleSolid 1
                     , _ptUpdate' = moveSmoke'' scal time p vel
                     }

moveSmoke'' :: Float -> Int -> Point2 -> Point2 -> World -> Particle' -> (World, Maybe Particle')
moveSmoke'' scal time p vel w pt
    | time > 0   = (w, Just $ pt { _ptPict' = pic
                                 , _ptUpdate' = moveSmoke'' scal (time-1) pNew vel
                                 })
    | time > -50 = (w, Just $ pt { _ptPict' = pi1
                                 , _ptUpdate' = moveSmoke'' scal (time-1) pNew vel
                                 })
    | otherwise  = (w, Nothing)
    where pNew = p +.+ vel
          pic = onLayerL [levLayer PtLayer] 
          --pic = onLayerL [levLayer PtLayer - 1] 
                    $ uncurry translate pNew 
                    $ color (greyN 0.5) $ circleSolid $ (21 - fromIntegral time) * scal
          pi1 = pictures $ reverse
                  [(onLayerL [levLayer PtLayer]
                    $ uncurry translate pNew 
                    $ color (withAlpha (0.3 * (1 + fromIntegral time /50)) (greyN 0.5)) 
                    $ circleSolid $ 21 * scal)
                    , 
                    --(onLayerL [levLayer BgLayer+1]
                    (onLayerL [levLayer PtLayer]
                    $ uncurry translate pNew 
                    $ color (withAlpha (1 + fromIntegral time /50) (greyN 0.5)) 
                    $ circleSolid $ 21 * scal)
                  ]

makeColorSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
makeColorSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
    where n = newProjectileKey w
          smP = Projectile
                { _ptPos = p
                , _ptStartPos = p
                , _ptVel = vel
                , _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 1
                , _ptID = n
                , _ptUpdate = moveColorSmoke col scal time n
                }

moveColorSmoke :: Color -> Float -> Int -> Int -> World -> World
moveColorSmoke col scal time i w
    | time > 0 
        = set (projectiles . ix i . ptPict) pic 
            . set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
            . set (projectiles . ix i . ptPos) newPos
            . setVel
            $ w
    | time > -50 
        = set (projectiles . ix i . ptPict) pi1 
            . set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
            . set (projectiles . ix i . ptPos) newPos
            . setVel
            $ w
    | otherwise 
        = over projectiles (IM.delete i) w
    where oldPos = _ptPos $ _projectiles w IM.! i
          newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i)
          setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99
          pic = onLayer PtLayer $ uncurry translate newPos $ color col $ circleSolid $ (21 - fromIntegral time) * scal
          pi1 = onLayer PtLayer $ uncurry translate newPos 
                    $ color (withAlpha (1 + fromIntegral time /50) col) 
                    $ circleSolid $ 21 * scal

damCrsOnLine :: Int -> Point2 -> Point2 -> World -> World
damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
    where damIfOnLine cr | circOnLine p1 p2 (_crPos cr) (_crRad cr) 
                                     = over crHP (\hp -> hp - dam) cr
                         | otherwise = cr

tempLightForAt :: Int -> Point2 -> World -> World
tempLightForAt i p w = w & tempLightSources %~ (:) (tLightAt i p)