{-# LANGUAGE BangPatterns #-}
module Dodge.Zoning.Base 
    ( zoneExtract
    , zoneOfPoint
    , zonesExtract
    , zoneOfSeg
    , zoneOfSegSet
    , zoneOfRect
    , zoneMonoid
    , deZoneIX
    , zoneOfCirc
    , zonesAroundPoint
    , xIntercepts
    , yIntercepts
    , updateInt2Map
    ) where

import Control.Lens
import qualified Data.IntSet as IS
import qualified Data.Set as S
--import Data.Maybe
import Geometry
import Geometry.Zone
import qualified IntMapHelp as IM

zoneOfCirc :: Float -> Point2 -> Float -> [Int2]
{-# INLINE zoneOfCirc #-}
zoneOfCirc zsize p r = zoneOfRect zsize (p + V2 r r) (p - V2 r r)

zoneOfRect :: Float -> Point2 -> Point2 -> [Int2]
{-# INLINE zoneOfRect #-}
zoneOfRect s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval sy ey]
  where
    V2 sx sy = zoneOfPoint s sp
    V2 ex ey = zoneOfPoint s ep

makeIntInterval :: Int -> Int -> [Int]
makeIntInterval x y
    | x < y = [x .. y]
    | otherwise = [y .. x]

--makeInt2Interval :: Int2 -> Int2 -> [Int2]
--makeInt2Interval (V2 x1 y1) (V2 x2 y2) =
--    [V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]

zoneOfPoint :: Float -> Point2 -> Int2
zoneOfPoint = fmap . divTo

zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2]
{-# INLINE zoneOfSeg #-}
zoneOfSeg s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep ++ yIntercepts s sp ep)

zoneOfSegSet :: Float -> Point2 -> Point2 -> S.Set Int2
{-# INLINE zoneOfSegSet #-}
zoneOfSegSet s sp = S.fromList . zoneOfSeg s sp

-- | zoneExtract (V2 x y) == fromMaybe mempty . (^? ix x . ix y)
zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m
{-# INLINE zoneExtract #-}
zoneExtract (V2 x y) = foldOf (ix x . ix y)

zonesExtract :: (Foldable f,Monoid m) => IM.IntMap (IM.IntMap m) -> f Int2 -> m
{-# INLINE zonesExtract #-}
zonesExtract = foldMap . flip zoneExtract

xIntercepts :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE xIntercepts #-}
xIntercepts s (V2 sx sy) (V2 ex ey) 
    | divTo s sx == divTo s ex = []
    | otherwise = g <$> [a, a + s .. b]
  where
    (a,b) | sx < ex = (ceilingTo s sx,floorTo s ex)
          | otherwise = (ceilingTo s ex,floorTo s sx)
    g x = V2 (h + x) (f x)
    h = 0.5 * s * signum (ex - sx)
    f x = sy + (x - sx) * (ey - sy) / (ex - sx)

yIntercepts :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE yIntercepts #-}
yIntercepts s sp ep = map f $ xIntercepts s (f sp) (f ep)
  where
    f (V2 x y) = V2 y x

-- consider using: at x . non mempty . at y . non mempty <>~ a
zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap (IM.IntMap m)
{-# INLINE zoneMonoid #-}
zoneMonoid (V2 !x !y) a = IM.insertWith f x $! IM.singleton y a
  where
    f _ = IM.insertWith (<>) y a

deZoneIX :: Int -> IM.IntMap (IM.IntMap IS.IntSet) -> Int2 -> IM.IntMap (IM.IntMap IS.IntSet)
deZoneIX i im (V2 x y) = im & ix x . ix y %~ IS.delete i

updateInt2Map :: (Eq a,Monoid a) => 
    (a -> a) -> Int2 -> IM.IntMap (IM.IntMap a) -> IM.IntMap (IM.IntMap a)
updateInt2Map f (V2 x y) = at x . non mempty . at y . non mempty %~ f

zonesAroundPoint :: Float -> Point2 -> [Int2]
zonesAroundPoint s p = [V2 a b | a <- [x -1 .. x + 1], b <- [y -1 .. y + 1]]
  where
    V2 x y = zoneOfPoint s p