{- |
Effects centered on creatures.
These are typically item effects, and typical occur when an item is explictly used.  -}
module Dodge.Item.Weapon.UseEffect
    where
import Dodge.Data
import Dodge.Base
import Dodge.Zone
import Dodge.Base.Collide
import Dodge.Picture.Layer
--import Dodge.Item.Weapon.Decoration
--import Dodge.Item.Weapon.TriggerType
--import Dodge.WorldEvent.Flash
--import Dodge.WorldEvent.ThingsHit
import Picture
import Geometry

import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- | Creates an outwardly increasing circle that draws creatures, even those behind walls.  -}
aSonarPulse :: Creature -> World -> World
aSonarPulse cr = over particles (sonarPulseAt (_crPos cr) :) 
{- | Creates an outwardly increasing circle that displays walls, even those behind other walls.  -}
aRadarPulse :: Creature -> World -> World
aRadarPulse cr = over particles (radarPulseAt (_crPos cr) :) 
{- | Radar blip at a point.  -}
blipAt :: Point2 -> Color -> Int -> Particle
blipAt p col i = Particle
    {_ptDraw = const blank
    ,_ptUpdate' = mvBlip p col i i
    }
mvBlip :: Point2 -> Color 
    -> Int  -- ^ Max possible timer value
    -> Int  -- ^ Current timer value
    -> World -> Particle -> (World, Maybe Particle)
mvBlip _ _   _    0 w _ = (w, Nothing)
mvBlip p col maxt t w pt = 
    (w
    , Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
        & ptDraw .~ ( const 
            . setDepth (-0.5)
            . setLayer 1
            . uncurryV translate p 
            . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
            $ circleSolid 2 )
    )
{- | An outwardly increasing circle that draws creatures, even those behind walls.  -}
sonarPulseAt :: Point2 -> Particle
sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p }

mvSonar 
    :: Int      -- ^ Timer
    -> Point2   -- ^ Center of expanding circle
    -> World -> Particle -> (World, Maybe Particle)
mvSonar 0 _ w _  = (w, Nothing)
mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
                              ,_ptUpdate' = mvSonar (x-1) p
                              }
                   )
  where 
    pic = setDepth (-0.5) . setLayer 1 $ pictures crBlips
    crBlips = mapMaybe crBlip $ IM.elems $ _creatures w
    crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100)
                  = Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100))
                         $ uncurryV translate cpos $ circleSolid crad
              | otherwise = Nothing
          where crad = _crRad cr
                cpos = _crPos cr
    r = fromIntegral (500 - x*5)
    --sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5 ]
    globalAlpha | x > 10 = 1
                | otherwise = fromIntegral x / 10
    colHelper y = color (withAlpha (y * globalAlpha) green)
{- |
An outwardly increasing circle that displays walls, even those behind other walls.  -}
radarPulseAt :: Point2 -> Particle
radarPulseAt p = Particle
    { _ptDraw = const blank
    , _ptUpdate' = mvRadar 50 p
    }
mvRadar 
    :: Int      -- ^ Timer
    -> Point2   -- ^ Center of expanding circle
    -> World -> Particle -> (World, Maybe Particle)
mvRadar 0 _ w _  = (w, Nothing)
mvRadar x p w pt = 
    ( putBlips w
    , Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvRadar (x-1) p }
    )
  where 
    pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics
    putBlips = over worldEvents ( over particles (blips ++) . )
    blips = map (\bp -> blipAt bp (withAlpha (0.5*globalAlpha) red) 50) circPoints
    circPoints = mapMaybe (\wl -> uncurry collidePointCircCorrect (_wlLine wl) r p)
        $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
                      ++ IM.elems (wallsAlongCirc p r w)
    swp (a,b) = (b,a)
    r = fromIntegral (800 - x*16)
    sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
                 --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5
                 --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5
                ]
    globalAlpha | x > 10 = 1
                | otherwise = fromIntegral x / 10
    --colHelper y = color (withAlpha (y * globalAlpha) red)

aTractorBeam 
    :: Int      -- ^ Color id
    -> Creature      -- ^ Creature id
    -> World 
    -> World
aTractorBeam col cr w 
    = set (creatures . ix cid . crInv . ix itRef . itUse)
        (\_ -> aTractorBeam ((col + 1) `mod` 10))
    $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
  where 
    i = newProjectileKey w
    cid = _crID cr
    pos = _crPos cr +.+ ((_crRad cr + 10) *.* unitVectorAtAngle dir)
    dir = _crDir cr
    itRef = _crInvSel cr
tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile
tractorBeamAt colID i pos dir = Projectile
    { _pjPos = pos
    , _pjStartPos = p'
    , _pjVel = d
    , _pjDraw = const blank
    , _pjID = i
    , _pjUpdate = \_ -> updateTractor colID 10 i
    }
  where 
    d  = unitVectorAtAngle dir
    p' = pos +.+ 400 *.* d

{- |
The interaction of this with objects, walls etc needs more thought.  -}
updateTractor :: Int -> Int -> Int -> World -> World
updateTractor colID time i w
    | time > 0 = set (projectiles . ix i . pjUpdate) (\_ -> updateTractor colID (time-1) i) 
                    $ set (projectiles . ix i . pjDraw) (const pic)
                    $ over creatures (IM.map tractCr) 
                    $ over floorItems (IM.map tractFlIt) 
                        w
    | otherwise = over projectiles (IM.delete i) w
  where 
    tractCr cr 
        | circOnSeg p1 p2 cP 10
                    = over crPos (\p -> 
                                   p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4))
                                 ) cr
        | otherwise = cr
       where 
        x = abs y + 1
        y = errorClosestPointOnLineParam 1 p1 p3 cP
        cP = _crPos cr
        m | dist cP p1 < 350 = 1
          | otherwise        = (400 - dist cP p1) / 50
    tractFlIt it | circOnSeg p1 p2 iP 10
                           = over flItPos  (\p -> p -.- m *.* 
                                                      ( (0.3/ x) *.* q +.+ (f y *.* p4))
                                           ) it
                 | otherwise = it
          where x = abs y + 1
                y = errorClosestPointOnLineParam 2 p1 p3 iP
                iP = _flItPos it
                m | dist iP p1 < 350 = 1
                  | otherwise        = (410 - dist iP p1) / 60
    pj = _projectiles w IM.! i
    q = _pjVel pj
    p1 = _pjPos pj
    p' = _pjStartPos pj
    p2 = maybe p' fst $ reflectPointWalls p1 p' $ wallsNearPoint p' w
    p4 = vNormal p5
    p5 = errorNormalizeV 12 $ p2 -.- p1
    p3 = p1 +.+ p4
    g x | x > 5 = (10 - x) / 5
        | x > 1 = 1
        | x > -1 = x
        | x > -5 = -1
        | otherwise = (x - 10) / 5
    f x = g x / 50
    col = mixColors 0.5 0.5 white blue
    px z = (fromIntegral time + 5) *.* z
    pz z = fromIntegral time * 10 *.* z
    pic = setLayer 1 $ onLayer PtLayer $ color (withAlpha 0.05 col) 
              $ polygon [ p1 +.+ px p4 
                        , p1 -.- 10 *.* p5
                        , p1 -.- px p4
                        , (p' -.- pz p5) -.- px p4
                        , (p' -.- pz p5) +.+ px p4]
