{- |
Creation of particles in the world.
 -}
module Dodge.WorldEvent.SpawnParticle
  where
import Dodge.Data
import Dodge.Creature.State.Data
import Dodge.Base
import Dodge.Base.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.Synonyms
import Dodge.RandomHelp
--import Dodge.Debug
import Picture
import Geometry
--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 = Pt'
    { _ptDraw         = drawFlame vel
    , _ptUpdate'      = moveFlame vel
    , _btVel'         = vel
    , _btColor'       = red
    , _btPos'         = pos
    , _btPassThrough' = maycid
    , _btWidth'       = 4
    , _btTimer'       = t
    , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff noEff
    }

drawFlame 
    :: Point2 -- ^ Rotate direction
    -> Particle -> Picture
drawFlame rotd pt = thePic
  where
    ep = _btPos' pt
    thePic = pictures 
        [ glow 
        , aPic 3 prot2 18 (V2 (scaleChange + 1)   2  ) red
        , aPic 4 prot  19 (V2 (scaleChange + 0.5) 1.5) orange
        , aPic 5 prot3 20 (V2  scaleChange        1  ) white
        ]
    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 _):_)       -> (soundAndGlare damcrs        , mvPt')
        (thing@(p,E3x2 wl):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
        _                     -> (soundAndGlare damcrs        , mvPt)
  where 
    time = _btTimer' pt
    soundAndGlare = soundFrom Flame fireSound 2 500 . over worldEvents ((.) $ flameGlareAt ep)
    sp = _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.2,0.5) (_randGen w)
    smokeGen = makeFlamerSmokeAt smokeCol 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 5 pic 
    , setLayer 4 pi2 
    , setLayer 3 piu 
    , setLayer 1 glow
    ]
  where
    z = _ptZ pt
    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 (z + 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 (z + 20)
        . 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 (z + 20)
        . 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)

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 = pos
        , _clVel = vel
        , _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col) 
                                          $ circleSolid 20
        , _clRad = 10
        , _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 c) w
    f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
    doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
makeTeslaArcAt :: Point2 -> Float -> Particle
makeTeslaArcAt pos dir = LinearParticle
    { _ptPoints = [pos]
    , _ptDraw = drawTeslaArc
    , _ptUpdate' = moveTeslaArc pos dir
    , _ptTimer = 2
    , _ptColor = white
    }
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
            & createSpark 8 nc q2 (argV sv + d1) Nothing
        , Just $ pt & ptTimer -~ 1
                            & ptPoints .~ ps'
                            & ptColor .~ theColor)
    | 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,g) = randomR (0::Int,5) $ _randGen w
    theColor = f2 nc
    f2 0 = cyan
    f2 1 = azure
    f2 _ = white
    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.
createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
createSpark time colid pos dir maycid w 
    = w & worldEvents %~ ( (over particles (spark :) . sparkFlashAt pos') . )
  where 
    spark = Bul'
        { _ptDraw = drawBul
        , _ptUpdate' = mvGenBullet
        , _btVel' = rotateV dir (V2 5 0)
        , _btColor' = brightX 100 1.5 $ numColor colid
        , _btTrail' = [pos]
        , _btPassThrough' = maycid
        , _btWidth' = 1
        , _btTimer' = time
        , _btHitEffect' = destroyOnImpact sparkEff noEff noEff
        }
    pos' = pos +.+ rotateV dir (V2 5 0)
    sparkEff bt p cr
        = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
      where 
        sp = head (_btTrail' bt)
        ep = sp +.+ _btVel' bt
createSparkCol :: Int -> Color -> Point2 -> Float -> Maybe Int -> World -> World
createSparkCol time col pos dir maycid w 
    = w & worldEvents %~ ( (over particles (spark :) . sparkFlashAt pos') . )
  where 
    spark = Bul'
        { _ptDraw = drawBul
        , _ptUpdate' = mvGenBullet
        , _btVel' = rotateV dir (V2 5 0)
        , _btColor' = col
        , _btTrail' = [pos]
        , _btPassThrough' = maycid
        , _btWidth' = 1
        , _btTimer' = time
        , _btHitEffect' = destroyOnImpact sparkEff noEff noEff
        }
    pos' = pos +.+ rotateV dir (V2 5 0)
    sparkEff bt p cr
        = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
      where 
        sp = head (_btTrail' bt)
        ep = sp +.+ _btVel' bt