module Dodge.RadarSweep where
import Dodge.Data
import Dodge.Zone
import Color
import Geometry
import LensHelp

import qualified Data.IntMap.Strict as IM
import qualified Streaming.Prelude as S

aRadarPulse :: Object -> Creature -> World -> World
aRadarPulse ob cr = radarSweeps .:~ RadarSweep
    { _rsTimer  = 100
    , _rsRad    = 0
    , _rsPos    = _crPos cr
    , _rsObject = ob
    }
updateRadarSweep
    :: World -> RadarSweep -> (World, Maybe RadarSweep)
updateRadarSweep w pt
    | x < 1 = (w, Nothing)
    | otherwise =
        ( putBlips w
        , Just $ pt & rsRad .~ r & rsTimer .~ (x-1)
        )
  where
    p = _rsPos pt
    ob = _rsObject pt
    blipsF = findBlips ob
    bf = makeBlip ob
    x = _rsTimer pt
    putBlips = radarBlips .++~ blips
    blips = map bf circPoints
    circPoints = blipsF p r w
    r = fromIntegral (400 - x*4)

findBlips :: Object -> Point2 -> Float -> World -> [Point2]
findBlips ob = case ob of
    ObCreature -> crBlips
    ObItem      -> itemBlips
    ObWall      -> wallBlips
    _ -> undefined
makeBlip :: Object -> Point2 -> RadarBlip
makeBlip ob = case ob of
    ObCreature  -> blipAt 8 (withAlpha 0.2 green) 50
    ObWall      -> blipAt 2 red 50
    ObItem      -> blipAt 6 blue 50
    _ -> undefined

{- | Radar blip at a point.  -}
blipAt :: Float -> Color -> Int -> Point2 -> RadarBlip
blipAt r col i p = RadarBlip
    {_rbColor = col
    ,_rbTime = i
    ,_rbMaxTime = i
    ,_rbRad = r
    ,_rbPos = p
    }

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

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)