module Dodge.Zone
    ( crZoneOfPoint
    , zoneOfLineIntMap
    , wallsNearPoint
    , wallsAlongLine
    , zoneSize
    , zoneOfPoint
    , wallsAlongCirc
    , wallsOnScreen
    , lookLookups
    , zoneAroundPoint
    , floorHun
    , zoneOfLine
    , wallsDoubleScreen
    , cloudZoneOfPoint
    , cloudsNearPoint
    , wallsNearZones
    , zoneOfSight
    , flattenIMIMIM
    )
    where
import Dodge.Data
import Dodge.Base.Window
import Geometry
import Geometry.Zone

import Data.Maybe
import Data.List
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS

--flattenZones ::  Zone (IM.IntMap a) -> IM.IntMap a
--flattenZones = flattenIMIMIM . _znObjects

zoneSize :: Float
zoneSize = 50

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'

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]]
    --f (x,y) = [(p,r) | p <-[x-2..x+2] , r<-[y-2..y+2]]

zoneOfLineIntMap :: Point2 -> Point2 -> IM.IntMap IS.IntSet
--{-# INLINE zoneOfLineIntMap #-}
--zoneOfLineIntMap = ddaExt zoneSize
zoneOfLineIntMap = ddaSq zoneSize

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

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

wallsDoubleScreen :: Configuration -> World -> IM.IntMap Wall
wallsDoubleScreen cfig w
    -- = foldl' (flip $ IM.union . \i -> innerFold (f i (_znObjects $ _wallsZone w))) IM.empty xs
    -- for some reason (TODO diagnose) the foldl' version causes errors
    = foldr (IM.union . \i -> innerFold (f i (_znObjects $ _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 (_windowX cfig) (_windowY cfig)
    xs = [x - n .. x + n]
    ys = [y - n .. y + n]

wallsOnScreen :: Configuration -> World -> IM.IntMap Wall
{-# INLINABLE wallsOnScreen #-}
wallsOnScreen cfig w
   -- = foldl' (flip $ IM.union . \i -> innerFold (f i (_znObjects $ _wallsZone w))) IM.empty xs
    = foldr (IM.union . \i -> innerFold (f i (_znObjects $ _wallsZone w))) IM.empty xs
  where 
    --innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys
    innerFold m = foldr (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 (_windowX cfig) (_windowY cfig)
    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 (_znObjects $ _wallsZone w))) IM.empty is
  where 
    f i m = case IM.lookup i m of 
        Just val -> val
        _        -> IM.empty

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

cloudsNearPoint :: Point2 -> World -> [Cloud]
--cloudsNearPoint p w =  IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
cloudsNearPoint p w = f (IM.lookup x (_znObjects $ _cloudsZone w) >>= IM.lookup y)
  where 
    (x,y) = cloudZoneOfPoint p
    f Nothing = []
    f (Just l) = l

-- 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 $ _znObjects $ _wallsZone w) s)) m
    kps = zoneOfLineIntMap a b
    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 $ _znObjects $ _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 $ _znObjects $ _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

flattenIMIMIM :: IM.IntMap (IM.IntMap (IM.IntMap a)) -> IM.IntMap a
flattenIMIMIM = IM.unions . fmap IM.unions