49 lines
1.4 KiB
Haskell
49 lines
1.4 KiB
Haskell
module Grid (
|
|
gridInPolygon,
|
|
gridPoints,
|
|
gridPoints'',
|
|
latticeXsYs,
|
|
) where
|
|
|
|
import Bound
|
|
import Control.Lens
|
|
import Geometry
|
|
|
|
gridInPolygon :: Float -> [Point2] -> [Point2]
|
|
gridInPolygon gap ps =
|
|
filter (`pointInPoly` ps)
|
|
. maybe [] (boundedGrid gap)
|
|
. boundPoints
|
|
$ 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
|
|
|
|
-- creates a DAG
|
|
latticeXsYs :: [Float] -> [Float] -> [(Point2, Point2)]
|
|
latticeXsYs xs ys =
|
|
foldMap (\y -> mkpairs xs & each . each %~ (`V2` y)) ys
|
|
<> foldMap (\x -> mkpairs ys & each . each %~ V2 x) xs
|
|
where
|
|
mkpairs (z:zs) = zip (z:zs) $ zs
|
|
mkpairs [] = []
|
|
|
|
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
|
|
|
|
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]]
|