{- | Deals with the specific implementations of zoning for Dodge.
 - These are not yet fixed down. -}
module Dodge.Base.Zone
    where
import Dodge.Data
import Dodge.Base.Window
import Geometry
import Geometry.Zone

import Data.Maybe
import Data.List
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
zoneSize :: Float
zoneSize = 50
--zoneSize = 100
          
floorHun :: Float -> Int
floorHun x = floor $ x / zoneSize

sizeZoneOfPoint :: Float -> Point2 -> (Int,Int)
sizeZoneOfPoint s (V2 x y) = (f x, f y)
  where
    f = floor . (/ s)

zoneOfPoint :: Point2 -> (Int,Int)
zoneOfPoint (V2 x y) = (floorHun x, floorHun y)

cloudZoneOfPoint :: Point2 -> (Int,Int)
cloudZoneOfPoint = sizeZoneOfPoint 20

crZoneOfPoint :: Point2 -> (Int,Int)
crZoneOfPoint = sizeZoneOfPoint 15

zoneNearPoint :: Point2 -> [(Int,Int)]
zoneNearPoint (V2 x' y') = [(a,b) | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
  where 
    x = floorHun x'
    y = floorHun y'

zoneAroundPoint :: Point2 -> [(Int,Int)]
zoneAroundPoint (V2 x' y') = [(a,b) | a<-[x-3..x+3] , b<-[y-3..y+3]]
  where 
    x = floorHun x'
    y = floorHun y'

zoneAroundPoint' :: Int -> Point2 -> IM.IntMap IS.IntSet
zoneAroundPoint' i (V2 x' y') = IM.fromSet (const ys) xs
  where 
    x = floorHun x'
    y = floorHun y'
    xs = IS.fromAscList [x-i..x+i]
    ys = IS.fromAscList [y-i..y+i]

-- the laser seemed to be occasionally missing creatures,
-- if this reoccurs, maybe change
-- divide line factor from 2 to 1.5
bres :: Point2 -> Point2 -> [(Int,Int)]
bres a b = digitalLine (zoneOfPoint a) (zoneOfPoint b)

bresx :: Point2 -> Point2 -> [(Int,Int)]
bresx a b = digitalLine (x-1,y-1) (x'-1,y'-1)
  where 
    (x,y) = zoneOfPoint a
    (x',y') = zoneOfPoint b

zoneOfLine :: Point2 -> Point2 -> [(Int,Int)]
zoneOfLine (V2 aa ab) (V2 ba bb) 
    = nub 
    . concatMap f 
    $ digitalLine (zoneOfPoint (V2 aa ab)) (zoneOfPoint (V2 ba bb))
  where 
    f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]

zoneOfLineIntMap :: Point2 -> Point2 -> IM.IntMap IS.IntSet
--{-# INLINE zoneOfLineIntMap #-}
zoneOfLineIntMap = ddaExt zoneSize
--zoneOfLineIntMap a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
--  where 
--    (x,y) = zoneOfPoint a
--    (x',y') = zoneOfPoint b


expandLine :: [(Int,Int)] -> IM.IntMap IS.IntSet
--{-# INLINE expandLine #-}
expandLine xs = IM.map expandSet 
    $ IM.unionsWith IS.union [im, IM.mapKeysMonotonic (+1) im, IM.mapKeysMonotonic (+2) im]
  where 
    im = IM.fromListWith IS.union $ map (second IS.singleton) xs
    -- the second was suggested by hlint, but it increases laziness, so might
    -- not be ideal
    expandSet s = IS.insert (mk+2) $ IS.insert (mk+1) s
      where 
        mk = IS.findMax s

                        
--zoneOfLine a b = concatMap zoneNearPoint $ divideLine (2 * zoneSize) a b
--zoneOfLine a b = concatMap zoneNearPoint $ divideLine zoneSize a b

zoneOfCircle :: Point2 -> Float -> [(Int,Int)]
zoneOfCircle p r = concatMap zoneNearPoint $ divideCircle (1.5 * zoneSize) p r

-- looking at this again, I am not convinced it deals correctly with the
-- rotation of the world
zoneOfScreen :: World -> [(Int,Int)]
zoneOfScreen w = [(a,b) | a <- [x - n .. x + n]
                        , b <- [y - n .. y + n]
                 ]
  where 
    (x,y) = zoneOfPoint $ _cameraCenter w
    n = ceiling $ wh / (_cameraZoom w * zoneSize)
    wh = max (getWindowX w) (getWindowY w)

zoneOfDoubleScreen :: World -> [(Int,Int)]
zoneOfDoubleScreen w = (,) <$> xs <*> ys
--    [(a,b) | a <- xs
--           , b <- ys
--    ]
  where 
    (x,y) = zoneOfPoint $ _cameraCenter w
    n = ceiling (wh / (_cameraZoom w * zoneSize)) * 2
    wh = max (getWindowX w) (getWindowY w)
    xs = [x - n .. x + n]
    ys = [y - n .. y + n]

zoneOfSight :: World -> [(Int,Int)]
zoneOfSight w = 
    [(a,b) 
        | a <- [minimum xs .. maximum xs]
        , b <- [minimum ys .. maximum ys]
    ]
  where 
    (xs,ys) = unzip $ map zoneOfPoint $ screenPolygon w ++ [_cameraViewFrom w]

wallsDoubleScreen :: World -> IM.IntMap Wall
wallsDoubleScreen w -- = IM.unions [f b $ f a $ _wallsZone w | (a,b) <- is]
    = foldl' (flip $ IM.union . \i -> innerFold (f i (_wallsZone w))) IM.empty xs
  where 
    innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys

    f i m = case IM.lookup i m of 
        Just val -> val
        _        -> IM.empty
    (x,y) = zoneOfPoint $ _cameraCenter w
    n = ceiling (wh / (_cameraZoom w * zoneSize)) * 2
    wh = max (getWindowX w) (getWindowY w)
    xs = [x - n .. x + n]
    ys = [y - n .. y + n]

wallsOnScreen :: World -> IM.IntMap Wall
wallsOnScreen w -- = wallsNearZones (zoneOfScreen w) w
    = foldl' (flip $ IM.union . \i -> innerFold (f i (_wallsZone w))) IM.empty xs
  where 
    innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys

    f i m = case IM.lookup i m of 
        Just val -> val
        _        -> IM.empty
    (x,y) = zoneOfPoint $ _cameraCenter w
    n = ceiling (wh / (_cameraZoom w * zoneSize))
    wh = max (getWindowX w) (getWindowY w)
    xs = [x - n .. x + n]
    ys = [y - n .. y + n]


wallsNearZones :: [(Int,Int)] -> World -> IM.IntMap Wall
wallsNearZones is w -- = IM.unions [f b $ f a $ _wallsZone w | (a,b) <- is]
    = foldl' (flip $ IM.union . \(a,b) -> f b (f a (_wallsZone w))) IM.empty is
  where 
    f i m = case IM.lookup i m of 
        Just val -> val
        _        -> IM.empty

ixZone :: IM.IntMap (IM.IntMap a) -> Point2 -> a
ixZone z (V2 x y) = z IM.! floorHun x IM.! floorHun y

ixNZ :: IM.IntMap (IM.IntMap a) -> Point2 -> [a]
ixNZ z p = lookLookups (zoneNearPoint p) z

lookLookup :: Int -> Int -> IM.IntMap (IM.IntMap a) -> Maybe a
lookLookup i j z = case IM.lookup i z of
    Just z' -> IM.lookup j z'
    Nothing -> Nothing

lookLookups :: [(Int,Int)] -> IM.IntMap (IM.IntMap a) -> [a]
lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs

-- possible BUG, was associated with thingsHitLongLine
-- assumes _wallsZone is correct level generation
-- there is certainly a problem somewhere here: it may be in the zoning, or
-- within this function
wallsAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Wall
--{-# INLINE wallsAlongLine #-}
wallsAlongLine a b w = IM.foldlWithKey' g IM.empty kps
  where 
    g m x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s)) m
    kps = zoneOfLineIntMap a b
    f i m = case IM.lookup i m of 
        Just val -> val
        _        -> IM.empty

wallsNearZone' :: IM.IntMap IS.IntSet -> World -> IM.IntMap Wall
{-# INLINE wallsNearZone' #-}
wallsNearZone' im w = IM.foldrWithKey' g IM.empty im
    where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s))
          f i m = case IM.lookup i m of Just val -> val
                                        _        -> IM.empty


wallsAlongCirc :: Point2 -> Float -> World -> IM.IntMap Wall
wallsAlongCirc p r w =  IM.unions [f y $ f x $ _wallsZone w | (x,y) <- zoneOfCircle p r]
    where f i m = case IM.lookup i m of Just val -> val
                                        _        -> IM.empty

wallsNearPoint :: Point2 -> World -> IM.IntMap Wall
wallsNearPoint p w =  IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
  where 
    (x,y) = zoneOfPoint p
    f i m = case IM.lookup i m of 
        Just val -> val
        _ -> IM.empty