{- |
Effects centered on creatures.
These are typically item effects, and typical occur when an item is explictly used.  -}
module Dodge.Item.Weapon.UseEffect 
    ( anItemFindPulse
    , aWallPulse
    , aSonarPulse
    ) where
import Dodge.Data
import Dodge.Zone
import Picture
import Geometry
import LensHelp

import qualified Data.IntMap.Strict as IM
import qualified Streaming.Prelude as S
{- | Creates an outwardly increasing circle that draws creatures, even those behind walls.  -}
aSonarPulse :: Creature -> World -> World
aSonarPulse = aRadarPulse crBlips (blipAt 8) (withAlpha 0.2 green)

aWallPulse :: Creature -> World -> World
aWallPulse = aRadarPulse wallBlips (blipAt 2) red

{- | Creates an outwardly increasing circle that displays items.  -}
anItemFindPulse :: Creature -> World -> World
anItemFindPulse = aRadarPulse itemBlips (openBlipAt 6) blue

aRadarPulse :: (Point2 -> Float -> World -> [Point2]) 
    -> (Point2 -> Color -> Int -> Particle)
    -> Color
    -> Creature 
    -> World -> World
aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle
    { _ptDraw   = drawPulse col
    , _ptUpdate = mvRadar blipsF bf col (_crPos cr)
    , _ptTimer  = 100
    , _ptRad    = 0
    , _ptPos    = _crPos cr
    }
drawPulse :: Color -> Particle -> Picture
drawPulse col pt = setLayer DebugLayer $ pictures sweepPics
  where
    p = _ptPos pt
    r = _ptRad pt
    sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
                ,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5
                ,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5
                ]
    colHelper y = color (withAlpha (y * globalAlpha) col)
    globalAlpha | x > 10 = 1
                | otherwise = fromIntegral x / 10
    x = _ptTimer pt
{- | Radar blip at a point.  -}
blipAt :: Float -> Point2 -> Color -> Int -> Particle
blipAt r p col i = Particle
    {_ptDraw = const blank
    ,_ptUpdate = mvBlip r p col i i
    }
mvBlip :: Float
    -> Point2 -> Color 
    -> Int  -- ^ Max possible timer value
    -> Int  -- ^ Current timer value
    -> World -> Particle -> (World, Maybe Particle)
mvBlip r p col maxt t w pt = case t of
    0 -> (w, Nothing)
    _ -> (w
        , Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1)
            & ptDraw .~ ( const 
                . setDepth (-0.5)
                . setLayer DebugLayer
                . uncurryV translate p 
                . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
                $ circleSolid r )
        )
{- | Radar blip at a point.  -}
openBlipAt :: Float -> Point2 -> Color -> Int -> Particle
openBlipAt r p col i = Particle
    {_ptDraw = const blank
    ,_ptUpdate = mvOpenBlip r p col i i
    }
mvOpenBlip :: Float
    -> Point2 -> Color 
    -> Int  -- ^ Max possible timer value
    -> Int  -- ^ Current timer value
    -> World -> Particle -> (World, Maybe Particle)
mvOpenBlip r p col maxt t w pt = case t of
    0 -> (w, Nothing)
    _ -> (w
        , Just $ pt & ptUpdate .~ mvOpenBlip r p col maxt (t-1)
            & ptDraw .~ ( const 
                . setDepth (-0.5)
                . setLayer DebugLayer
                . uncurryV translate p 
                . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
                $ thickCircle r 3)
        )

mvRadar 
    :: (Point2 -> Float -> World -> [Point2])
    -> (Point2 -> Color -> Int -> Particle)
    -> Color
    -> Point2   -- ^ Center of expanding circle
    -> World -> Particle -> (World, Maybe Particle)
mvRadar blipsF bf col p w pt
    | x < 1 = (w, Nothing)
    | otherwise =
        ( putBlips w
        , Just $ pt & ptRad .~ r & ptTimer .~ (x-1)
        )
  where
    x = _ptTimer pt
    putBlips = over worldEvents ( over instantParticles (blips ++) . )
    blips = map (\bp -> bf bp (withAlpha (0.5*globalAlpha) col) 50) circPoints
    circPoints = blipsF p r w
    r = fromIntegral (400 - x*4)
    globalAlpha | x > 10 = 1
                | otherwise = fromIntegral x / 10

itemBlips :: Point2 -> Float -> World -> [Point2]
itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
  where
    f q = dist p q <= r && dist p q > r - 4

wallBlips :: Point2 -> Float -> World -> [Point2]
wallBlips p r w = runIdentity . S.toList_ $ S.mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine)
        $ S.map (over wlLine swp) (wlsInsideCirc p r w)
                      <> wlsInsideCirc p r w
  where
    swp (a,b) = (b,a)

crBlips :: Point2 -> Float -> World -> [Point2]
crBlips p r = IM.elems . IM.filter f . fmap _crPos .  IM.filter g . _creatures
  where
    f q = dist p q <= r && dist p q > r - 100
    g cr = _crID cr /= 0
