module Grid where
import Geometry
import Bound

--import Data.Function (on)
import Data.List
import Data.Bifunctor
--import Data.Maybe
import qualified Data.Tuple.Extra as Tup
import qualified Streaming.Prelude as S
--import qualified Control.Foldl as L
--import qualified Data.Set as S

gridInPolygon :: Float -> [Point2] -> [Point2]
gridInPolygon gap ps = filter (`pointInPolygon` ps)
    .  maybe [] (boundedGrid gap) . boundPoints . S.each $ ps

boundedGrid :: Float -> (Float,Float,Float,Float) -> [Point2]
boundedGrid gap (n,s,e,w) = gridPointsOff w s gap nx gap ny
  where
    nx = floor $ (e-w) / gap
    ny = floor $ (n-s) / gap

shiftedGrid
    :: Float    -- ^ x min
    -> Float    -- ^ x max
    -> Float    -- ^ y min
    -> Float    -- ^ y max
    -> [(Point2,Point2)]
shiftedGrid xmin xmax ymin ymax = grid
  where
    xd = xmax - xmin
    yd = ymax - ymin
    xsteps = ceiling $ (xd - 40) / 60
    ysteps = ceiling $ (yd - 40) / 60
    shift p = bimap (p +.+) (p +.+)
    grid = map (shift (V2 (xmin + 20) (ymin+20))) $ makeGrid 60 xsteps 60 ysteps

-- creates a rectangular grid starting at (0,0) in the positive orthant
-- needs fixing in degenerate (xstep or ystep == 0) cases
makeGrid 
    :: Float    -- ^ horizontal step size
    -> Int      -- ^ number of horizontal steps
    -> Float    -- ^ vertical step size
    -> Int      -- ^ number of vertical steps
    -> [(Point2,Point2)]
makeGrid x nx y ny 
    = nub 
    . concatMap doublePair 
    . concatMap (\p -> map (Tup.both (p +.+)) $ makeRect x y)
    $ gridPoints x nx y ny

gridPointsOff :: Float -> Float -> Float -> Int -> Float -> Int -> [Point2]
gridPointsOff xoff yoff x nx y ny = map f $ gridPoints' nx ny
  where
    f (a,b) = V2 (xoff + fromIntegral a * x) (yoff + fromIntegral b * y)

gridPoints :: Float -> Int -> Float -> Int -> [Point2]
gridPoints = gridPointsOff 0 0
--    map f $ gridPoints' nx ny
--  where
--    f (a,b) = V2 (fromIntegral a * x) (fromIntegral b * y)

gridPoints'' :: Float -> Int -> Float -> Int -> [(Point2,(Int,Int))]
gridPoints'' x nx y ny = map f $ gridPoints' nx ny
  where
    f (a,b) = (V2 (fromIntegral a * x) (fromIntegral b * y), (a,b))

gridPoints' :: Int -> Int -> [(Int,Int)]
gridPoints' nx ny = [(x,y) | x <- [0..nx-1], y <- [0..ny-1]]

makeRect :: Float -> Float -> [(Point2,Point2)]
makeRect x y = map (bimap toV2 toV2) 
    [((0,0),(x,0))
    ,((0,0),(0,y))
    ,((x,y),(x,0))
    ,((x,y),(0,y))
    ]