{- |
Creation of particles in the world.
 -}
module Dodge.WorldEvent.SpawnParticle
  where
import Dodge.Data
import Dodge.Data.DamageType
import Dodge.Data.SoundOrigin
import Dodge.Default
import Dodge.Creature.State.Data
import Dodge.Base
import Dodge.Zone
import Dodge.Base.Collide
import Dodge.Picture
--import Dodge.Picture.Layer
import Dodge.WorldEvent.HitEffect
import Dodge.WorldEvent.ThingsHit
import Dodge.WorldEvent.Cloud
--import Dodge.WorldEvent.Flash
import Dodge.Particle.Bullet.Draw
import Dodge.Particle.Bullet.Update
import Dodge.SoundLogic
import Dodge.SoundLogic.LoadSound
import Dodge.RandomHelp
--import Dodge.Debug
import Picture
import Geometry
import Geometry.Vector3D
--import Geometry.Data
import qualified IntMapHelp as IM

import Control.Lens
import System.Random
import Control.Monad.State
import Data.Function (on)
import Data.List
import Data.Maybe
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
    , _btVel'         = vel
    , _btColor'       = red
    , _btPos'         = pos
    , _btPassThrough' = maycid
    , _btWidth'       = 4
    , _btTimer'       = t
    , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff noEff
    , _ptZ            = 20
    }
drawFlame 
    :: Point2 -- ^ Rotate direction
    -> Particle 
    -> Picture
drawFlame rotd pt = thePic
  where
    ep = _btPos' pt
    thePic = 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
        ]
    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 = _btTimer' 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 = (smokeGen w, Nothing)
    | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
        ((_,E3x1 _):_)       -> (doSound damcrs        , mvPt')
        (thing@(p,E3x2 wl):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
        _                     -> (glare $ doSound damcrs        , mvPt)
  where 
    time = _btTimer' pt
    doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2) -- . over worldEvents ((.) $ flameGlareAt ep)
    glare 
        | time `mod` 5 == 0
                    = tempLightSources %~ (theTLS :)
        | otherwise = id
    theTLS = defaultTLS
        { _tlsPos = V3 x y 10
        , _tlsRad = 70
        , _tlsIntensity = V3 0.5 0 0
        }
    sp@(V2 x y) = _btPos' pt
    vel = _btVel' pt
    ep = sp +.+ vel
    mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep
                     , _btPassThrough' = Nothing
                     ,_btVel' = 0.98 *.* vel}
    mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep
                     , _btPassThrough' = Nothing
                     ,_btVel' = 0.7 *.* vel}
    damcrs = foldr (\cr -> fst . hiteff [(ep,E3x1 cr)]) w 
        $ filter closeCrs 
        $ IM.elems $ _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 = _btHitEffect' pt pt
    rfl wl p = Just $ pt 
        { _btTimer' = time -1
        , _btPos' = pOut p
        , _btVel' = reflV wl
        }
    pOut p = p +.+ safeNormalizeV (sp -.- p)
    reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
        +.+ (0.2 *.* vel)
    smokeCol = fst $ randomR (0.5,0.8) (_randGen w)
    smokeGen = makeFlamerSmokeAt smokeCol (addZ 20 ep)

makeFlameletTimed 
    :: Point2       -- ^ Position
    -> Float        -- ^ z position
    -> Point2       -- ^ Velocity
    -> Maybe Int    -- ^ Creature id
    -> Float        -- ^ Size
    -> Int          -- ^ Timer
    -> World 
    -> World
makeFlameletTimed (V2 x y) z vel maycid size time w = w
    & randGen   .~ g 
    & particles %~ (theFlamelet :)
  where   
    theFlamelet = PtZ 
        { _ptDraw         = drawFlameletZ rot
        , _ptUpdate      = moveFlamelet
        , _btVel'         = vel
        , _btColor'       = red
        , _btPos'         = V2 x y
        , _btPassThrough' = maycid
        , _btWidth'       = size
        , _btTimer'       = time
        , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff noEff
        , _ptZ = z
        }
    (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 = _btPos' pt
    vel = _btVel' pt
    ep = sp +.+ vel
    size = _btWidth' pt
    siz2 = size + 0.2
    time = _btTimer' pt
    piu = setDepth (z + 25)
        .  uncurryV translate ep 
        -- . color (V4 2 (-0.5) (-0.5) 1) 
        . 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)

drawFlamelet 
    :: Float    -- ^ Rotation
    -> Particle
    -> Picture
drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
  where
    sp = _btPos' pt
    vel = _btVel' pt
    ep = sp +.+ vel
    size = _btWidth' pt
    siz2 = size + 0.2
    time = _btTimer' pt
    glow = setDepth 19 $ uncurryV translate ep
                $ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30
    piu = setDepth 20
        .  uncurryV translate ep 
        . color (dark red) 
        . rotate (negate (rot - 0.1 * fromIntegral time))
        . scale s1 s1
        . polygon 
        $ rectNSWE siz2 (-siz2) (-siz2) siz2
    pi2 = setDepth 20.2
        . uncurryV translate ep
        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                           orange                          (dark red)
                   )
        . rotate (negate (rot + 0.2 * fromIntegral time))
        . scale s2 s2
        . polygon 
        $ rectNSWE siz2 (-siz2) (-siz2) siz2
    pic = setDepth 20.4
        . uncurryV translate ep
        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                           white                           (dark red)
                )
        . rotate (negate ( 0.1 * fromIntegral time + rot))
        . scale sc 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 
    | _btTimer' pt <= 0 = (     w, Nothing)
    | otherwise         = (damcrs,    mvPt)
  where   
    sp = _btPos' pt
    vel = _btVel' pt
    ep = sp +.+ vel
    size = _btWidth' pt
    mvPt = Just $ pt & btTimer'       -~ 1
                     & btPos'         .~ ep
                     & btPassThrough' .~ Nothing
                     & btVel'         .~ 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 %~ ( Flaming 3 sp ep ep : )
        | 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 (stripZ $ _clPos c) w
    f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
    doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
makeTeslaArcAt :: Color -> Point2 -> Float -> Particle
makeTeslaArcAt col pos dir = LinearParticle
    { _ptPoints = [pos]
    , _ptDraw = drawTeslaArc
    , _ptUpdate = moveTeslaArc pos dir
    , _ptTimer = 2
    , _ptColor = brightX 100 1.5 col
    }
drawTeslaArc :: Particle -> Picture
drawTeslaArc pt = pic
  where
    ps' = _ptPoints pt
    pic = setLayer 1 $ pictures 
             [ setDepth 20.5 $ color (brightX 2 2 $ _ptColor pt) $ lineOfThickness 3 ps'
--             , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
--             , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
--             , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
             ]
-- todo: fix electrical damage location
moveTeslaArc 
    :: Point2   -- ^ Emmission position
    -> Float    -- ^ Emmission direction
    -> World 
    -> Particle
    -> (World, Maybe Particle)
moveTeslaArc p d w pt
    | t == 2 = 
        (foldr damCrs w hitCrs & randGen .~ g
            & createSparkCol 8 nc q2 (argV sv + d1)
        , Just $ pt 
            & ptTimer -~ 1
            & ptPoints .~ ps'
        )
    | t < 1 = (w , Nothing)
    | otherwise = (w , Just $ pt & ptTimer -~ 1)
 where 
    t = _ptTimer pt
    ps = take 25 $ p : map f (crsLightChain p d 0 w)
    f (E3x1 cr) = _crPos cr
    f (E3x2 p1) = p1
    f (E3x3 p1) = p1
    ps' = lightningMids d pers ps
    pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
    nc = brightX 100 1.5 $ numColor colid
    (colid,g) = randomR (0::Int,5) $ _randGen w
    f1 (E3x1 cr) = Just $ _crID cr
    f1 _         = Nothing
    hitCrs       = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
    damCrs cid = over (creatures . ix cid . crState . crDamage) (Electrical 5 cpos cpos cpos :)
      where 
        cpos = _crPos (_creatures w IM.! cid)
    q1 = last $ init ps'
    q2 = last ps'
    hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
    sv = maybe (q2 -.- q1) snd hitWall

{-
Finds a point somewhere roughly inbetween two points.
 -}
lightningMid :: Float -> Point2 -> Point2 -> Point2
lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
    where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2

{-
Finds extra middle points between successive points in a list of points.
-}
lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
lightningMids d1 (p:pers) (p1:p3:ps)
    = let p2 = p +.+ lightningMid d1 p1 p3
          d2 = argV $ p3 -.- p2
      in  p1 : p2 : lightningMids d2 pers (p3:ps)
lightningMids _ _ ps = ps

{-
Finds a list of hit things from a given point.
'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space.
 -}
crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
crsLightChain p d wlAttract w
    = case crOrWallSensitive p d wlAttract w of
        E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) 
                                           (min 1 (wlAttract + 0.3)) w
        E3x2 p1 -> [E3x2 p1]
        E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
    -- where (dChange, g) = (0, _randGen w)
    where (dChange, g) = randomR (-0.5,0.5) $ _randGen w
{-
Finds whether a creature or wall is in front of a given point and direction.
Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.
Has a parameter to tweak how attracted the test is to walls.
 -}
crOrWallSensitive 
    :: Point2   -- ^ Start point
    -> Float    -- ^ Direction (radians)
    -> Float    -- ^ Wall attraction parameter
    -> World 
    -> Either3 Creature Point2 Point2
crOrWallSensitive p dir wlAttract w = 
    fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
    . listToMaybe 
    . sortBy (compare `on` g)
    $ catMaybes [cr,wlp]
  where 
    cr  = E3x1 <$> nearestCrInFront p dir 100 w
    wlp = fmap E3x2 
        . listToMaybe
        . sortBy (compare `on` dist p)
        $ mapMaybe 
            ( fmap fst
            . (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w)
            . (+.+) p
            . (\d -> rotateV d (V2 100 0))
            . (+ dir)
            . (* wlAttract)
            )
            [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
    g (E3x2 p1)  = 100 + dist p p1 -- tweak makes it more likely to hit crs first
    --g (E3x2 p1)  = dist p p1 - 100 -- tweak makes it more likely to hit walls first
    g (E3x1 cr1) = dist p $ _crPos cr1
    g _ = 0
    (arcLen,_) = randomR (25,50) $ _randGen w
-- BUG: can hit crs through walls
{- Finds whether a creature or wall is in front of a given point and direction.
Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.  -}
crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2
crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
                        $ listToMaybe $ sortBy (compare `on` g)
                                        $ catMaybes [cr,wlp]
  where 
    cr  = E3x1 <$> nearestCrInFront p dir 100 w
    wlp = fmap E3x2 
        $ listToMaybe
        $ sortBy (compare `on` dist p)
        $ mapMaybe 
            ( fmap fst
            . (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w)
            . (+.+) p
            . (\d -> rotateV d (V2 100 0))
            . (+) dir
            )
            [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
            --[-pi/4,-pi/8,0,pi/8,pi/4]
    g (E3x2 p1)  = 100 + dist p p1 -- tweak makes it more likely to hit crs first
    --g (E3x2 p1)  = dist p p1 - 100 -- tweak makes it more likely to hit walls first
    g (E3x1 cr1) = dist p $ _crPos cr1
    g _ = 0
    (arcLen,_) = randomR (25,50) $ _randGen w
-- | Create a spark. 
-- If the spark is created by another Particle, it cannot be directly added to
-- the list, hence the redirect through worldEvents.
createSparkCol :: Int -> Color -> Point2 -> Float -> World -> World
createSparkCol time col pos dir w 
    = w & worldEvents %~ ( over particles (spark :) . )
  where 
    spark = BulletPt
        { _ptDraw = drawBul
        , _ptUpdate = mvGenBullet
        , _btVel' = rotateV dir (V2 5 0)
        , _btColor' = col
        , _btTrail' = [pos]
        , _btPassThrough' = Nothing
        , _btWidth' = 1
        , _btTimer' = time
        , _btHitEffect' = destroyOnImpact sparkEff noEff noEff
        }
    sparkEff bt p cr
        = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
      where 
        sp = head (_btTrail' bt)
        ep = sp +.+ _btVel' bt