Use grid when creating block debris

src/Grid.hs

@@ -0,0 +1,78 @@
+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 (flip 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))
+    ]