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

Cleanup

Browse Source
This commit is contained in:
justin
2022-07-27 12:49:23 +01:00
parent 6554d219dc
commit 8d17ce66e9
106 changed files with 2911 additions and 2678 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Zoning/Base.hs
+21 -19
View File
@@ -1,12 +1,12 @@
module Dodge.Zoning.Base where
import Control.Lens
import qualified Data.IntSet as IS
import Data.Maybe
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)
@@ -18,37 +18,39 @@ zoneOfRect' s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval
makeIntInterval :: Int -> Int -> [Int]
makeIntInterval x y
| x < y = [x..y]
| otherwise = [y..x]
| 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]
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)
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 :: 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 (`zoneExtract` im)
{-# INLINE zonesExtract #-}
zonesExtract = foldMap . flip zoneExtract
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)
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
sx'
| xdx < 0 = sx - modTo s sx
| otherwise = s + sx - modTo s sx
yIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
@@ -62,7 +64,7 @@ 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 :: 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
@@ -70,6 +72,6 @@ zoneOfPoint'' :: Float -> Point2 -> Int2
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] ]
zonesAroundPoint s p = [V2 a b | a <- [x -1 .. x + 1], b <- [y -1 .. y + 1]]
where
V2 x y = zoneOfPoint' s p