76 lines
2.5 KiB
Haskell
76 lines
2.5 KiB
Haskell
module Dodge.Zoning.Base where
|
|
import Geometry
|
|
import Geometry.Zone
|
|
import qualified IntMapHelp as IM
|
|
|
|
import qualified Data.IntSet as IS
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
|
|
zoneOfCirc :: Float -> Point2 -> Float -> [Int2]
|
|
zoneOfCirc zsize p r = zoneOfRect' zsize (p +.+ V2 r r) (p -.- V2 r r)
|
|
|
|
zoneOfRect' :: Float -> Point2 -> Point2 -> [Int2]
|
|
zoneOfRect' s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval sy ey]
|
|
where
|
|
V2 sx sy = zoneOfPoint' s sp
|
|
V2 ex ey = zoneOfPoint' s ep
|
|
|
|
makeIntInterval :: Int -> Int -> [Int]
|
|
makeIntInterval x y
|
|
| x < y = [x..y]
|
|
| otherwise = [y..x]
|
|
|
|
makeInt2Interval :: Int2 -> Int2 -> [Int2]
|
|
makeInt2Interval (V2 x1 y1) (V2 x2 y2)
|
|
= [(V2 x y) | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]
|
|
|
|
zoneOfPoint' :: Float -> Point2 -> Int2
|
|
zoneOfPoint' s = fmap (divTo s)
|
|
|
|
zoneOfSeg' :: Float -> Point2 -> Point2 -> [Int2]
|
|
zoneOfSeg' s sp ep = map (zoneOfPoint' s) (sp : xIntercepts' s sp ep ++ yIntercepts' s sp ep)
|
|
|
|
zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m
|
|
zoneExtract (V2 x y) = fromMaybe mempty . (^? ix x . ix y)
|
|
--
|
|
zonesExtract :: Monoid m => IM.IntMap (IM.IntMap m) -> [Int2] -> m
|
|
zonesExtract im = foldMap (flip zoneExtract im)
|
|
|
|
xIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
|
|
{-# INLINE xIntercepts' #-}
|
|
xIntercepts' s (V2 sx sy) (V2 ex ey)
|
|
| xdx == 0 = []
|
|
| xdx > 0 = zipWith V2 [sx',sx'+xdx*50..ex] ([sy',sy'+ydx*50..ey] ++ repeat ey)
|
|
| otherwise = zipWith V2 [sx'-50,sx'+xdx*50-50..ex-50] ([sy',sy'+ydx*50..ey] ++ repeat ey)
|
|
where
|
|
xdx = signum (ex - sx)
|
|
ydx = (ey - sy) / abs (ex - sx) -- carefull: if this is zero
|
|
|
|
sy' = sy + ydx * abs (sx - sx')
|
|
sx' | xdx < 0 = sx - modTo s sx
|
|
| otherwise = s + sx - modTo s sx
|
|
|
|
yIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
|
|
{-# INLINE yIntercepts' #-}
|
|
yIntercepts' s sp ep = map f $ xIntercepts' s (f sp) (f ep)
|
|
where
|
|
f (V2 x y) = V2 y x
|
|
|
|
zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap (IM.IntMap m)
|
|
zoneMonoid (V2 x y) a = IM.insertWith f x $ IM.singleton y a
|
|
where
|
|
f _ = IM.insertWith (<>) y a
|
|
|
|
deZoneIX :: Int -> IM.IntMap (IM.IntMap IS.IntSet) -> Int2 -> IM.IntMap (IM.IntMap IS.IntSet)
|
|
deZoneIX i im (V2 x y) = im & ix x . ix y %~ IS.delete i
|
|
|
|
zoneOfPoint'' :: Float -> Point2 -> Int2
|
|
{-# INLINE zoneOfPoint'' #-}
|
|
zoneOfPoint'' s = fmap (divTo s)
|
|
|
|
zonesAroundPoint :: Float -> Point2 -> [Int2]
|
|
zonesAroundPoint s p = [V2 a b | a <- [x-1..x+1] , b <- [y-1..y+1] ]
|
|
where
|
|
V2 x y = zoneOfPoint' s p
|