Improve xIntercepts (still not perfect)

src/Dodge/Zoning/Base.hs

@@ -4,18 +4,20 @@ module Dodge.Zoning.Base
     , zoneOfPoint
     , zonesExtract
     , zoneOfSeg
+    , zoneOfSegSet
     , zoneOfRect
     , zoneMonoid
     , deZoneIX
     , zoneOfCirc
     , zonesAroundPoint
     , xIntercepts
-    , yIntercepts'
+    , yIntercepts
     , updateInt2Map
     ) where
 
 import Control.Lens
 import qualified Data.IntSet as IS
+import qualified Data.Set as S
 --import Data.Maybe
 import Geometry
 import Geometry.Zone
@@ -46,21 +48,26 @@ 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 s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep ++ yIntercepts s sp ep)
+--zoneOfSeg s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep )
+
+zoneOfSegSet :: Float -> Point2 -> Point2 -> S.Set Int2
+{-# INLINE zoneOfSegSet #-}
+zoneOfSegSet s sp = S.fromList . zoneOfSeg s sp
 
 -- | 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
+zonesExtract :: (Foldable f,Monoid m) => IM.IntMap (IM.IntMap m) -> f 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 = []
+    | divTo s sx == divTo s ex = []
     | otherwise = zipWith V2 [halfstep + sx', halfstep + sx' + xdx * s .. ex] ([sy', sy' + ydx * s .. ey] ++ repeat ey)
   where
     halfstep
@@ -73,9 +80,9 @@ xIntercepts s (V2 sx sy) (V2 ex ey)
         | 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)
+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