justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Make pathedge zoning use sets, probably doesn't help

Browse Source
This commit is contained in:
justin
2022-08-24 14:01:39 +01:00
parent 13b07b53ce
commit 6973663055
16 changed files with 68 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Zoning/Base.hs
+13 -13
View File
@@ -13,8 +13,8 @@ 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
V2 sx sy = zoneOfPoint s sp
V2 ex ey = zoneOfPoint s ep
makeIntInterval :: Int -> Int -> [Int]
makeIntInterval x y
@@ -25,12 +25,12 @@ 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
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)
zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2]
{-# INLINE zoneOfSeg #-}
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)
@@ -39,9 +39,9 @@ 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)
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
@@ -57,12 +57,12 @@ xIntercepts' s (V2 sx sy) (V2 ex ey)
yIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE yIntercepts' #-}
yIntercepts' s sp ep = map f $ xIntercepts' s (f sp) (f ep)
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
zoneMonoid (V2 x y) a = IM.insertWith f x $! IM.singleton y a
where
f _ = IM.insertWith (<>) y a
@@ -76,4 +76,4 @@ 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
V2 x y = zoneOfPoint s p