93 lines
2.8 KiB
Haskell
93 lines
2.8 KiB
Haskell
module Dodge.Zoning.Base
|
|
( zoneExtract
|
|
, zoneOfPoint
|
|
, zonesExtract
|
|
, zoneOfSeg
|
|
, zoneOfRect
|
|
, zoneMonoid
|
|
, deZoneIX
|
|
, zoneOfCirc
|
|
, zonesAroundPoint
|
|
, xIntercepts
|
|
, yIntercepts'
|
|
) where
|
|
|
|
import Control.Lens
|
|
import qualified Data.IntSet as IS
|
|
--import Data.Maybe
|
|
import Geometry
|
|
import Geometry.Zone
|
|
import qualified IntMapHelp as IM
|
|
|
|
zoneOfCirc :: Float -> Point2 -> Float -> [Int2]
|
|
{-# INLINE zoneOfCirc #-}
|
|
zoneOfCirc zsize p r = zoneOfRect zsize (p +.+ V2 r r) (p -.- V2 r r)
|
|
|
|
zoneOfRect :: Float -> Point2 -> Point2 -> [Int2]
|
|
{-# INLINE zoneOfRect #-}
|
|
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 = fmap . divTo
|
|
|
|
zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2]
|
|
{-# INLINE zoneOfSeg #-}
|
|
zoneOfSeg s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep ++ yIntercepts' s sp ep)
|
|
|
|
-- | zoneExtract (V2 x y) == fromMaybe mempty . (^? ix x . ix y)
|
|
zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m
|
|
{-# INLINE zoneExtract #-}
|
|
zoneExtract (V2 x y) = foldOf (ix x . ix y)
|
|
|
|
zonesExtract :: Monoid m => IM.IntMap (IM.IntMap m) -> [Int2] -> m
|
|
{-# INLINE zonesExtract #-}
|
|
zonesExtract = foldMap . flip zoneExtract
|
|
|
|
xIntercepts :: Float -> Point2 -> Point2 -> [Point2]
|
|
{-# INLINE xIntercepts #-}
|
|
xIntercepts s (V2 sx sy) (V2 ex ey)
|
|
| xdx == 0 = []
|
|
| otherwise = zipWith V2 [halfstep + sx', halfstep + sx' + xdx * s .. ex] ([sy', sy' + ydx * s .. ey] ++ repeat ey)
|
|
where
|
|
halfstep
|
|
| xdx > 0 = -s/2
|
|
| otherwise = s/2
|
|
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)
|
|
{-# INLINE zoneMonoid #-}
|
|
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
|
|
|
|
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
|