module Dodge.Zoning.Base 
    ( zoneExtract
    , zoneOfPoint
    , zonesExtract
    , zoneOfSeg
    , zoneOfRect
    , zoneMonoid
    , deZoneIX
    , zoneOfCirc
    , zonesAroundPoint
    , xIntercepts
    , yIntercepts'
    ) where

import Control.Lens
import qualified Data.IntSet as IS
--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)

-- | 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 :: Monoid m => IM.IntMap (IM.IntMap m) -> [Int2] -> m
{-# INLINE zonesExtract #-}
zonesExtract = foldMap . flip zoneExtract

xIntercepts :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE xIntercepts #-}
xIntercepts s (V2 sx sy) (V2 ex ey)
    | xdx == 0 = []
    | otherwise = zipWith V2 [halfstep + sx', halfstep + sx' + xdx * s .. ex] ([sy', sy' + ydx * s .. ey] ++ repeat ey)
  where
    halfstep
        | xdx > 0 = -s/2
        | otherwise = s/2
    xdx = signum (ex - sx)
    ydx = (ey - sy) / abs (ex - sx) -- carefull: if this is zero
    sy' = sy + ydx * abs (sx - sx')
    sx'
        | xdx < 0 = sx - modTo s sx
        | otherwise = s + sx - modTo s 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

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

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