{-# LANGUAGE TupleSections #-}

module Dodge.RadarSweep (
    aRadarPulse,
    updateRadarSweep,
) where

import Color
import Data.Maybe
import qualified Data.Set as S
import Dodge.Data.World
import Dodge.Item.Location
import Dodge.Zoning.Wall
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import NewInt

aRadarPulse ::
    NewInt ItmInt ->
    Maybe (NewInt ItmInt) ->
    Maybe (NewInt ItmInt) ->
    ObjectType ->
    Creature ->
    World ->
    World
aRadarPulse itid mitid armitid ob cr =
    cWorld . lWorld . radarSweeps
        .:~ RadarSweep
            { _rsTimer = 50
            , _rsRad = 0
            , _rsPos = _crPos cr
            , _rsObject = ob
            , _rsMapper = mitid
            , _rsAR = armitid
            , _rsSource = itid
            }

updateRadarSweep :: World -> RadarSweep -> (World, Maybe RadarSweep)
updateRadarSweep w pt
    | x < 1 = (w, Nothing)
    | otherwise =
        ( putBlips w & updatemapper
        , Just $ pt & rsRad .~ r & rsTimer .~ (x -1)
        )
  where
    updatemapper = fromMaybe id $ do
        itid <- pt ^. rsMapper
        return $ pointerToItemID itid . itUse . useMapperLines <>~ wps
    p = _rsPos pt
    ob = _rsObject pt
    x = _rsTimer pt
    putBlips 
        | isJust (pt ^. rsAR) = cWorld . lWorld . radarBlips
            .++~ map
                (makeBlip ob)
                blips
        | otherwise = id
    (blips, wps) = findBlips ob p r w
    r = fromIntegral (400 - x * 8)

findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
findBlips ob = case ob of
    ObCreature -> crBlips
    ObItem -> itemBlips
    ObWall -> wallBlips
    _ -> undefined

makeBlip :: ObjectType -> 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], S.Set (Point2, Point2))
crBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld
  where
    f q = dist p q <= r && dist p q > r - 100
    g cr = _crID cr /= 0

itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld
  where
    f q = dist p q <= r && dist p q > r - 4

wallBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
wallBlips p r = foldMap f . wlsNearCirc p r
  where
    f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
        [] -> mempty
        xs -> (xs, S.singleton (wl ^. wlLine))