{- | Creation of particles in the world.  -}
module Dodge.WorldEvent.SpawnParticle
    ( makeGasCloud
    , aFlameParticle
    , makeFlamelet
    ) where
import Dodge.Data
import Dodge.Base
import Dodge.WorldEvent.HitEffect
import Dodge.WorldEvent.ThingsHit
import Dodge.WorldEvent.Cloud
import Dodge.WorldEvent.Flash
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.Wall.Damage
import Picture
import Geometry
import qualified IntMapHelp as IM
import LensHelp

import System.Random
import Control.Monad.State
import Data.Tuple
aFlameParticle 
    :: Int      -- ^ Timer
    -> Point2   -- ^ Position
    -> Point2   -- ^ Velocity
    -> Maybe Int -- ^ Creature id
    -> Particle
aFlameParticle t pos vel maycid = PtZ
    { _ptDraw       = drawFlame vel
    , _ptUpdate     = moveFlame vel
    , _ptVel        = vel
    , _ptColor      = red
    , _ptPos        = pos
    , _ptCrIgnore   = maycid
    , _ptWidth      = 4
    , _ptTimer      = t
    , _ptHitEff     = destroyOnImpact (doFlameDam 1) 
        (\_ p -> damageWall (Damage Flaming 19 p p p NoDamageEffect))
    , _ptZ           = 20
    }
drawFlame
    :: Point2 -- ^ Rotate direction
    -> Particle 
    -> Picture
drawFlame rotd pt = pictures
    [ glow 
    , aPic 3 prot2 25 (V2 (scaleChange + 1)   2  ) $ V4 2 (-1) (-1) 0.5
    , aPic 3 prot  22 (V2 (scaleChange + 0.5) 1  ) $ V4 1 0.5    0  2
    , aPic 1 prot3 20 (V2  scaleChange        0.5) $ V4 1 1      1  1
    ]
  where
    ep = _ptPos pt
    aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
    aPic lay offset depth (V2 scalex scaley) col
        = setLayer lay 
        . setDepth depth 
        . uncurryV translate (offset ep)
        . rotate (pi * 0.5 + argV rotd)
        . scale scalex scaley
        . color col                 
        $ circleSolid 5
    glow = setLayer 1 $ setDepth 0.3 $ uncurryV translate ep
        $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
    time = _ptTimer pt
    scaleChange 
        | time < 80 = 3
        | otherwise = 3 - (fromIntegral time - 80) * 0.2
    prot  p' = p' +.+ rotateV (fromIntegral time) (V2 0 1)
    prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1)
    prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2)
{- TODO: add generalised area damage particles/hiteffects.  -}
moveFlame :: Point2   -- ^ Rotation direction
    -> World 
    -> Particle
    -> (World, Maybe Particle)
moveFlame rotd w pt 
    | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
    | otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of
        ((_,Left _):_)      -> (doSound damcrs                      , mvPt 0.7)
        (th@(p,Right wl):_) -> (doSound . fst $ hiteff [th] damcrs  , rfl wl p)
        _                   -> (flameFlicker pt $ doSound damcrs    , mvPt 0.98)
  where 
    time = _ptTimer pt
    doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2)
    sp@(V2 x y) = _ptPos pt
    vel = _ptVel pt
    ep = sp +.+ vel
    mvPt speed = Just $ pt 
        { _ptTimer = time - 1
        , _ptPos = ep
        , _ptCrIgnore = Nothing
        , _ptVel = speed *.* vel    }
    damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w $ IM.filter closeCrs $ _creatures w
    closeCrs cr = dist ep (_crPos cr) 
                    < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
                                + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
    angleCoeff x' = abs $ 1 - abs ( (x' * 2 - pi) / pi )
    hiteff = _ptHitEff pt pt
    rfl wl p = Just $ pt 
        { _ptTimer = time - 1
        , _ptPos = pOut p
        , _ptVel = reflV wl
        }
    pOut p = p +.+ squashNormalizeV (sp -.- p)
    reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
        +.+ (0.2 *.* vel)

makeFlamelet
    :: Point2       -- ^ Position
    -> Float        -- ^ z position
    -> Point2       -- ^ Velocity
    -> Maybe Int    -- ^ Ignore creature id
    -> Float        -- ^ Size
    -> Int          -- ^ Timer
    -> World 
    -> World
makeFlamelet (V2 x y) z vel maycid size time w = w
    & randGen   .~ g
    & instantParticles .:~ PtZ 
        { _ptDraw         = drawFlameletZ rot
        , _ptUpdate       = moveFlamelet
        , _ptVel          = vel
        , _ptColor        = red
        , _ptPos         = V2 x y
        , _ptCrIgnore = maycid
        , _ptWidth       = size
        , _ptTimer       = time
        , _ptHitEff   = destroyOnImpact (doFlameDam 1) noEff
        , _ptZ = z
        }
  where
    (rot ,g) = randomR (0,3) $ _randGen w

drawFlameletZ
    :: Float    -- ^ Rotation
    -> Particle
    -> Picture
drawFlameletZ rot pt = pictures 
    [ setLayer 1 pic 
    , setLayer 3 piu 
    , setLayer 3 pi2 
    ]
  where
    z = _ptZ pt
    sp = _ptPos pt
    vel = _ptVel pt
    ep = sp +.+ vel
    size = _ptWidth pt
    siz2 = size + 0.2
    time = _ptTimer pt
    piu = setDepth (z + 25)
        .  uncurryV translate ep 
        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                           (V4 2 0 0 1)                          (V4 2 0 0 0)
                   )
        . rotate (negate (rot - 0.1 * fromIntegral time))
        . scale s1 s1
        $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
    pi2 = setDepth (z + 25)
        . uncurryV translate ep
        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                           (V4 2 1 0 0.5)                          (V4 0 0 0 0)
                   )
        . rotate (negate (rot + 0.2 * fromIntegral time))
        . scale s2 s2
        $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
    pic = setDepth (z + 20)
        . uncurryV translate ep
        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                           (V4 1 1 1 3)                           (V4 1 0 0 1)
                )
        . rotate (negate ( 0.1 * fromIntegral time + rot))
        . scale (0.5* sc) (0.5 *sc)
        $ polygon $ map toV2 [(-size,-size),(size,-size),(size,size),(-size,size)]
    sc = (*) 2 $ log $ 1 + fromIntegral time / 20
    s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
    s2 = 0.5 * (sc + s1)

{- Update of a flamelet.
Applies movement and attaches damage to nearby creatures.  -}
moveFlamelet :: World -> Particle -> (World, Maybe Particle)
moveFlamelet w pt 
    | _ptTimer pt <= 0 = (     w, Nothing)
    | otherwise         = (flameFlicker pt damcrs,    mvPt)
  where   
    sp = _ptPos pt
    vel = _ptVel pt
    ep = sp +.+ vel
    size = _ptWidth pt
    mvPt = Just $ pt & ptTimer   -~ 1
                     & ptPos     .~ ep
                     & ptCrIgnore .~ Nothing
                     & ptVel      .~ 0.8 *.* vel
    damcrs = w & creatures %~ IM.map damifclose
    isClose cr = dist ep (_crPos cr) < _crRad cr + size
    damifclose cr 
        | isClose cr = cr & crState . crDamage .:~ Damage Flaming 3 sp ep ep NoDamageEffect
        | otherwise  = cr
-- | At writing the radius is half the size of the effect area
makeGasCloud 
    :: Point2   -- ^ Position
    -> Point2   -- ^ Velocity
    -> World 
    -> World
makeGasCloud pos vel w = w
    & clouds    .:~ theCloud
    & randGen   .~ g
  where 
    theCloud = Cloud 
        {  _clPos = addZ 20 pos
        , _clVel = addZ 0 vel
        , _clPict = \_ -> setLayer 2 . setDepth 30 $ color (withAlpha 0.05 col) 
                                          $ circleSolid 20
        , _clRad = 10
        , _clAlt = 25
        , _clTimer = 400
        , _clType = GasCloud
        , _clEffect = cloudPoisonDamage
        }
    (col, g) = runState (takeOne [green,yellow]) $ _randGen w
{- Attach poison cloud damage to creatures near cloud.  -}
cloudPoisonDamage :: Cloud -> World -> World
cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
  where 
    damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w
    f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
    doDam cr = cr & crState . crDamage .:~ Damage PoisonDam 1 clpos clpos clpos NoDamageEffect
    clpos = stripZ $ _clPos c