Improve line zoning

src/Dodge/Base.hs

@@ -74,7 +74,7 @@ wallNormal wl = normalizeV . vNormal $ a -.- b
 wallsOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall]
 wallsOnLine p1 p2 ws = hitWalls
   where 
-    hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w)
+    hitPoint w = uncurry (intersectSegSeg p1 p2) (_wlLine w)
     hitWalls = filter (isJust . hitPoint) (IM.elems ws)
 
 wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall
@@ -252,7 +252,7 @@ collidePointFF  = undefined
 --                    -> Maybe (Point2,(Maybe (Point2,StdGen),Int))
 --collidePointFF p1 p2 g ff = fmap f ip
 --    where (p3:p4:_) = _ffLine ff
---          ip  = intersectSegSeg' p1 p2 p3 p4
+--          ip  = intersectSegSeg p1 p2 p3 p4
 --          ref = (_ffDeflect ff) <*> Just g <*> Just (p2 -.- p1) <*> Just ff
 --          f p = (p, (ref, _ffID ff))
 --
@@ -267,7 +267,7 @@ collideCircWalls' p1 p2 rad ws
             ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
             . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))
             ) 
-            (intersectSegSeg' p1 p2 x y)
+            (intersectSegSeg p1 p2 x y)
          ) 
          . shiftByRad . _wlLine
         ) ws
@@ -288,7 +288,7 @@ collideCircWalls' p1 p2 rad ws
 collidePointLines :: Point2 -> Point2 -> [Wall'] -> Maybe (Point2,Point2)
 collidePointLines p1 p2 ws 
     = safeMinimumOn f
-    $ mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
+    $ mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
         . _wlLine') ws
   where 
     f (a,_) = magV (p1 -.- a)
@@ -298,7 +298,7 @@ collidePointLines p1 p2 ws
 collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
 collidePointWallsNorm p1 p2 ws 
     = safeMinimumOn f 
-    $ IM.mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
+    $ IM.mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
         . _wlLine) ws
   where 
     f (a,_) = magV (p1 -.- a)

src/Dodge/Base/Collide.hs

@@ -24,7 +24,7 @@ hitPointLines
 hitPointLines p1 p2
     = safeMinimumOn (dist p1 . fst)
     . mapMaybe
-    (\(x,y) -> (, (x,y)) <$> intersectSegSeg' p1 p2 x y)
+    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)
 
 -- | looks for first collision of a point with walls
 -- if found, gives point and reflection velocity
@@ -36,7 +36,7 @@ reflectPointWalls p1 p2 ws
             fmap ( (, reflectIn (x -.- y) (p2 -.- p1)) 
                  . (+.+ errorNormalizeV 39 (vNormal (x -.- y)))
                  ) 
-                 (intersectSegSeg' p1 p2 x y)
+                 (intersectSegSeg p1 p2 x y)
          ) 
         . _wlLine) ws
 -- | Looks for first collision of a point with walls.
@@ -52,43 +52,43 @@ reflectPointWallsDamped dfact p1 p2 ws
     $ IM.mapMaybe 
         (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
                             . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
-                                (intersectSegSeg' p1 p2 x y)) 
+                                (intersectSegSeg p1 p2 x y)) 
          . _wlLine
         ) ws
 -- | Test if a point collides with walls
 pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 pointHitsWalls p1 p2 
-    = any $ isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine
+    = any $ isJust . uncurry (intersectSegSeg p1 p2) . _wlLine
 -- | Test if there something blocking a walk
 collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 collidePointWalkable p1 p2 ws 
-    = any (isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine) 
+    = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
     $ IM.filter (fromMaybe True . (^? doorPathable)) ws
 
 furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
 furthestPointWalkable p1 p2 ws 
     = fromMaybe p2
     . safeMinimumOn (dist p1) 
-    $ IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) ws
+    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
 
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
 collidePointIndirect p1 p2 ws 
     = safeMinimumOn (dist p1) 
-    . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) 
+    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
     $ IM.filter (not . _wlIsSeeThrough) ws
 {- | Checks to see whether someone can fire bullets effectively between two points. 
  - Not sure if this needs vision as well, need to make this uniform. -}
 collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 collidePointFire p1 p2 ws 
     = safeMinimumOn (dist p1) 
-    . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine ) 
+    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
     $ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? blHP))) ws
 {- | Checks to see whether someone can fire bullets effectively between two points. 
  - Not sure if this needs vision as well, need to make this uniform. -}
 collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 collidePointFireVision p1 p2 ws 
-    = any ( isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine) 
+    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
     $ IM.filter notBlockWindow ws
   where 
     notBlockWindow wl = case wl ^? blHP of

src/Dodge/Base/Zone.hs

@@ -5,6 +5,7 @@ module Dodge.Base.Zone
 import Dodge.Data
 import Dodge.Base.Window
 import Geometry
+import Geometry.Zone
 
 import Data.Maybe
 import Data.List
@@ -73,14 +74,16 @@ zoneOfLine (V2 aa ab) (V2 ba bb)
     f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
 
 zoneOfLineIntMap :: Point2 -> Point2 -> IM.IntMap IS.IntSet
-{-# INLINE zoneOfLineIntMap #-}
+--{-# INLINE zoneOfLineIntMap #-}
-zoneOfLineIntMap a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
+zoneOfLineIntMap = ddaExt zoneSize
-  where 
+--zoneOfLineIntMap a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
-    (x,y) = zoneOfPoint a
+--  where 
-    (x',y') = zoneOfPoint b
+--    (x,y) = zoneOfPoint a
+--    (x',y') = zoneOfPoint b
+
 
 expandLine :: [(Int,Int)] -> IM.IntMap IS.IntSet
-{-# INLINE expandLine #-}
+--{-# INLINE expandLine #-}
 expandLine xs = IM.map expandSet 
     $ IM.unionsWith IS.union [im, IM.mapKeysMonotonic (+1) im, IM.mapKeysMonotonic (+2) im]
   where 
@@ -172,10 +175,10 @@ lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs
 -- there is certainly a problem somewhere here: it may be in the zoning, or
 -- within this function
 wallsAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Wall
-{-# INLINE wallsAlongLine #-}
+--{-# INLINE wallsAlongLine #-}
-wallsAlongLine a b w = IM.foldrWithKey' g IM.empty kps
+wallsAlongLine a b w = IM.foldlWithKey' g IM.empty kps
   where 
-    g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s))
+    g m x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s)) m
     kps = zoneOfLineIntMap a b
     f i m = case IM.lookup i m of 
         Just val -> val

src/Dodge/LevelGen/Pathing.hs

@@ -23,6 +23,6 @@ removePathsCrossing a b w = set pathGraph newGraph $ set pathGraph' pg'
     $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
     w
   where 
-    pg' = filter (isNothing . uncurry (intersectSegSeg' a b)) $ _pathGraph' w
+    pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraph' w
     insertPoint  pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
     newGraph = pairsToGraph dist pg'

src/Dodge/LevelGen/TriggerDoor.hs

@@ -30,7 +30,7 @@ addButtonDoor c btp btr a b w = over buttons (IM.insert bid bt)
     bid = IM.newKey $ _buttons w
     cond w' = BtNoLabel == _btState (_buttons w' IM.! bid)
     bt = (makeButton c eff) {_btPos = btp, _btRot = btr, _btID = bid}
-    (newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg' a b)) 
+    (newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg a b)) 
                                              $ _pathGraph' w
     newGraph = pairsToGraph dist newGraphPairs
     insertPoint  pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
@@ -49,7 +49,7 @@ addSwitchDoor c btp btr a b w = over buttons (IM.insert bid bt)
     bid = IM.newKey $ _buttons w
     cond w' = BtOn == _btState (_buttons w' IM.! bid)
     bt = (makeSwitch c openDoor closeDoor) {_btPos = btp, _btRot = btr, _btID = bid}
-    (newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg' a b)) 
+    (newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg a b)) 
                                              $ _pathGraph' w
     newGraph = pairsToGraph dist newGraphPairs
     insertPoint  pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]

src/Dodge/Render/Picture.hs

@@ -121,7 +121,7 @@ wallShadowsToDraw w = filter (fromMaybe True . (^? blVisible))
 -- towards the center of sight
 lineOnScreenCone :: World -> Point2 -> Point2 -> Bool
 lineOnScreenCone w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp 
-                                                || any (isJust . uncurry (intersectSegSeg' p1 p2)) sps
+                                                || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
   where 
     sp' = screenPolygon w
     vp = _cameraViewFrom w
@@ -132,7 +132,7 @@ lineOnScreenCone w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
 
 lineOnScreen :: World -> Point2 -> Point2 -> Bool
 lineOnScreen w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp 
-                                                || any (isJust . uncurry (intersectSegSeg' p1 p2)) sps
+                                                || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
   where 
     sp = screenPolygon w
     sps = zip sp (tail sp ++ [head sp])
@@ -160,7 +160,7 @@ extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] +
   where 
     borderPs = mapMaybe (intersectLinefromScreen w c) [x,y]
     cornerPs = filter (pointIsInCone c (x,y)) $ screenPolygon w
-    wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg' y ((2*.*y) -.- x)) 
+    wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg y ((2*.*y) -.- x)) 
                               . makeLoopPairs $ screenPolygon w
 
 rectangleSolid :: Float -> Float -> Picture

src/Dodge/Update.hs

@@ -226,5 +226,5 @@ visibleWalls p1 p2 ws
     . map f 
     $ IM.toList ws
   where 
-    f (i,wl) = (uncurry intersectSegSeg' (_wlLine wl) p1 p2, (i,wl))
+    f (i,wl) = (uncurry intersectSegSeg (_wlLine wl) p1 p2, (i,wl))
 

src/Dodge/WallCreatureCollisions.hs

@@ -105,11 +105,11 @@ checkPushThroughs cp1 wls cp2
 
 checkPushThrough :: Point2 -> Point2 -> (Point2,Point2) -> Maybe Point2
 checkPushThrough cp1 cp2 (wp1,wp2) 
-    | isPushedThrough = intersectSegSeg' cp1 cp2 wp1 wp2
+    | isPushedThrough = intersectSegSeg cp1 cp2 wp1 wp2
     | otherwise = Nothing
   where
     --norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
     --wp1' = (rad *.* norm) +.+ wp1
     --wp2' = (rad *.* norm) +.+ wp2
     --newP = errorClosestPointOnLine 5 wp1' wp2' cp2
-    isPushedThrough = isRHS wp1 wp2 cp2 && isJust (intersectSegSeg' cp1 cp2 wp1 wp2)
+    isPushedThrough = isRHS wp1 wp2 cp2 && isJust (intersectSegSeg cp1 cp2 wp1 wp2)

src/Dodge/WorldEvent/ThingsHit.hs

@@ -34,7 +34,7 @@ thingsHit sp ep w
         Just val -> val
         _        -> IM.empty
     wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
-    hitPoint w' = uncurry (intersectSegSeg' sp ep) (_wlLine w')
+    hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w')
     hitFFs   = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
     ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
 {- List objects that appear on a line.
@@ -76,7 +76,7 @@ thingsHitLongLine sp ep w
     crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
     wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
     hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
-    hitPoint wl = uncurry (intersectSegSeg' sp ep) (_wlLine wl)
+    hitPoint wl = uncurry (intersectSegSeg sp ep) (_wlLine wl)
     hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
     ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
 

src/Geometry.hs

@@ -15,6 +15,7 @@ module Geometry
     , module Geometry.Bezier
     , module Geometry.Vector
     , module Geometry.LHS
+    --, module Geometry.Zone
     )
     where
 import Geometry.Data
@@ -22,11 +23,9 @@ import Geometry.Intersect
 import Geometry.Bezier
 import Geometry.Vector
 import Geometry.LHS
+--import Geometry.Zone
 
---import Data.Function
 import Data.List
-import Data.Maybe
---import Control.Applicative
 -- | Return a point a distance away from a first point towards a second point.
 -- Does not go past the second point.
 alongSegBy :: Float -> Point2 -> Point2 -> Point2
@@ -191,48 +190,6 @@ doublePair (x,y) = [(x,y),(y,x)]
 
 doubleV2 :: V2 a -> [V2 a]
 doubleV2 (V2 x y) = [V2 x y,V2 y x]
-
--- | Test whether two polygons intersect by testing the intersection of each
--- consecutive pair of points.
---polysIntersect :: [Point2] -> [Point2] -> Bool
---{-# INLINE polysIntersect #-}
---polysIntersect (p:ps) (q:qs) 
---    -- = any isJust $ (\(V2 a b) (V2 c d) -> myIntersectSegSeg a b c d) <$> pairs1 <*> pairs2
---    = or $ (\(V2 a b) (V2 c d) -> isJust $ myIntersectSegSeg a b c d) <$> pairs1 <*> pairs2
---  where 
---    pairs1 = zipWith V2 (p:ps) (ps++[p])
---    pairs2 = zipWith V2 (q:qs) (qs++[q])
---polysIntersect _ _ = False
-
-polysIntersect :: [Point2] -> [Point2] -> Bool
-polysIntersect (a:b:xs) ps = go a (a:b:xs) ps
-  where
-    go x' (a':b':xs') ps' = pairPolyIntersect a' b' ps' || go x' (b':xs') ps'
-    go b' (a':[]) ps' = pairPolyIntersect a' b' ps'
-    go _ _ _ = False
-polysIntersect _ _ = False
-
-pairPolyIntersect :: Point2 -> Point2 -> [Point2] -> Bool
-pairPolyIntersect a' b' (c':d':xs') = go c' a' b' (c':d':xs')
-  where
-    go x a b (c:d:xs) 
-        | isJust $ myIntersectSegSeg a b c d = True
-        | otherwise = go x a b (d:xs)
-    go d a b (c:[]) = isJust $ myIntersectSegSeg a b c d
-    go _ _ _ _ = False
-pairPolyIntersect _ _ _ = False
-
--- | Test whether two polygons intersect or if one is contained in the other.
-polysOverlap :: [Point2] -> [Point2] -> Bool
-polysOverlap (p:ps) (q:qs) = pointInPolygon p (q:qs)
-    || pointInPolygon q (p:ps)
-    || polysIntersect (p:ps) (q:qs) 
-polysOverlap _ _ = False
--- | Test whether any polygons from a first list intersect with any polygons from
--- a second list.
-anyPolyssIntersect :: [[Point2]] -> [[Point2]] -> Bool
-anyPolyssIntersect x y = or $ polysIntersect <$> x <*> y
-
 -- split a list into triples, forms triangles from a polygon
 polyToTris :: [s] -> [s]
 {-# INLINE polyToTris #-}
@@ -394,10 +351,11 @@ divideLineExact x a b = map ( (a +.+ ) . ( *.* v) ) [0 , x .. d]
     d = dist a b
     v = normalizeV $ b -.- a
 
+
 -- | Given two pairs of Ints, returns a list of pairs of Ints that form 
 -- a digital line between them.
 digitalLine :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
-{-# INLINE digitalLine #-}
+--{-# INLINE digitalLine #-}
 digitalLine (x1,y1) (x2,y2) 
     | abs (x1-x2) > abs (y1-y2) = 
         [ (x,( (y1-y2) * x + x1*y2 - x2*y1) `rdiv` (x1-x2) ) 
@@ -421,8 +379,9 @@ digitalRect (a,b) (c,d) = [(s,t) | s <- [minx .. maxx] , t <- [miny .. maxy]]
     miny = min b d
 -- | Given two Ints, creates the list of Ints between these.
 intervalList :: Int -> Int -> [Int]
+{-# INLINE intervalList #-}
 intervalList x y 
-    | y >= x = [x .. y]
+    | y > x = [x .. y]
     | otherwise = reverse [y..x]
 -- | Create points on the circumference of a circle with maximal distance
 -- between them.

src/Geometry/ConvexPoly.hs

@@ -57,7 +57,7 @@ polyPointsIntersect :: [Point2] -> [Point2] -> Bool
 polyPointsIntersect (a:b:xs) ps = go a (a:b:xs) ps
   where
     go x' (a':b':xs') ps' = pairPolyPointsIntersect a' b' ps' || go x' (b':xs') ps'
-    go b' (a':[]) ps' = pairPolyPointsIntersect a' b' ps'
+    go b' [a'] ps' = pairPolyPointsIntersect a' b' ps'
     go _ _ _ = False
 polyPointsIntersect _ _ = False
 
@@ -67,7 +67,7 @@ pairPolyPointsIntersect a' b' (c':d':xs') = go c' a' b' (c':d':xs')
     go x a b (c:d:xs) 
         | isJust $ myIntersectSegSeg a b c d = True
         | otherwise = go x a b (d:xs)
-    go d a b (c:[]) = isJust $ myIntersectSegSeg a b c d
+    go d a b [c] = isJust $ myIntersectSegSeg a b c d
     go _ _ _ _ = False
 pairPolyPointsIntersect _ _ _ = False
 

src/Geometry/Intersect.hs

@@ -18,9 +18,9 @@ intersectLineLine' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
 -- | If two segments intersect, return 'Just' that point.
-intersectSegSeg' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+intersectSegSeg :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
-{-# INLINE intersectSegSeg' #-}
+{-# INLINE intersectSegSeg #-}
-intersectSegSeg' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
+intersectSegSeg (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     | den == 0 = Nothing
     | den > 0 && (t' < 0 || u' < 0 || t' > den || u' > den)
         = Nothing

src/Geometry/Zone.hs

@@ -0,0 +1,149 @@
+{-# LANGUAGE TupleSections #-}
+module Geometry.Zone
+    ( ddaExt
+    ) 
+    where
+import Geometry.Data
+
+import Data.Foldable
+import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
+
+foldl2'
+    :: (b -> a -> a -> b) 
+    -> b 
+    -> [a]
+    -> b
+foldl2' f s (t:ts) = fst $ foldl' g (s, t) ts
+  where
+    g (r,x) y = (f r x y,y)
+foldl2' _ s _ = s
+
+sortArguments 
+    :: Ord a 
+    => (a -> a -> b)
+    -> a -> a -> b
+sortArguments f x y
+    | x < y = f x y
+    | otherwise = f y x
+sortArgumentsReverse
+    :: Ord a 
+    => (a -> a -> [b])
+    -> a -> a -> [b]
+sortArgumentsReverse f x y
+    | x < y = f x y
+    | otherwise = reverse $ f y x
+
+intervalBounds
+    :: Float    -- ^ interval threshold
+    -> Float    -- ^ First endpoint
+    -> Float    -- ^ Second endpoint
+    -> [Float]
+intervalBounds = sortArgumentsReverse . f
+  where 
+    f r a b 
+        | x > b = [a]
+        | otherwise = (a : [x,x+r..b])
+      where
+        x = floorTo r a + r
+
+floorTo :: Float -> Float -> Float
+floorTo r x = r * (fromIntegral ((floor $ x / r) :: Int))
+
+ceilingTo :: Float -> Float -> Float
+ceilingTo r x = r * (fromIntegral ((ceiling $ x / r) :: Int))
+
+divTo :: Float -> Float -> Int
+{-# INLINE divTo #-}
+divTo s = floor . (/s)
+
+flipV :: Point2 -> Point2
+{-# INLINE flipV #-}
+flipV (V2 a b) = V2 b a
+
+applyInverted 
+    :: (Point2 -> Point2 -> [Point2])
+    -> Point2 -> Point2 -> [Point2]
+applyInverted f sp@(V2 sx sy) ep@(V2 ex ey)
+    | abs (sx-ex) > abs (sy-ey) = f sp ep
+    | otherwise = map flipV $ f (flipV sp) (flipV ep)
+
+sizeZoneOfPoint' :: Float -> Point2 -> V2 Int
+sizeZoneOfPoint' s = fmap (divTo s)
+
+increasingInterval :: Int -> Int -> [Int]
+increasingInterval x y
+    | y > x = [x .. y]
+    | otherwise = [y .. x]
+
+-- | Determines which horizontal and vertical lines on a grid are crossed by a
+-- line. For each adds the x-y index of the square to the right or above the
+-- crossed grid line. Also adds the index of the square containing the start
+-- point.
+ddaExt :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet
+ddaExt s sp@(V2 sx sy) ep@(V2 ex ey) 
+    | x1 <= x2 = addys . IM.fromDistinctAscList $ zip [x1 .. x2] 
+                    $ map (IS.singleton . divTo s) [x1y,x1y+ydx..]
+    | otherwise = addys . IM.fromDistinctAscList $ zip [x2-1 .. x1-1]
+                    $ map (IS.singleton . divTo s) [x2y,x2y+ydx..]
+  where
+    x1 = divTo s sx
+    x2 = divTo s ex
+    x1y = fx' sp ep $ s * (fromIntegral x1)
+    x2y = fx' sp ep $ s * (fromIntegral x2)
+    ydx = s * ydx' sp ep
+    addys m = add2s m ypairs 
+    y1 = divTo s sy
+    y2 = divTo s ey
+    y1x = fy' sp ep $ s * (fromIntegral y1)
+    y2x = fy' sp ep $ s * (fromIntegral y2)
+    xdy = s * xdy' sp ep
+    ypairs 
+        | y1 <= y2  = zip (map (divTo s) [y1x,y1x+xdy..])
+                         [y1 .. y2] 
+        | otherwise = zip (map (divTo s) [y2x,y2x+xdy..])
+                         [y2-1 .. y1-1] 
+
+ydx' :: Point2 -> Point2 -> Float
+{-# INLINE ydx' #-}
+ydx' (V2 sx sy) (V2 ex ey)
+    | sx == ex = 0
+    | otherwise = (ey - sy) / (ex - sx)
+xInt' :: Float -> Point2 -> Point2 -> Float
+xInt' s (V2 sx _) (V2 ex _)
+    | ex > sx = ceilingTo s sx
+    | otherwise = floorTo s sx
+fx' :: Point2 -> Point2 -> Float -> Float
+fx' sp@(V2 sx sy) ep@(V2 _ ey) x
+    | sy == ey = sy
+    | otherwise = sy + ydx' sp ep * (x - sx)
+
+xdy' :: Point2 -> Point2 -> Float
+xdy' (V2 sx sy) (V2 ex ey)
+    | sy == ey = 0
+    | otherwise = (ex - sx) / (ey - sy)
+yInt' :: Float -> Point2 -> Point2 -> Float
+yInt' s (V2 _ sy) (V2 _ ey)
+    | ey > sy = ceilingTo s sy
+    | otherwise = floorTo s sy
+fy' :: Point2 -> Point2 -> Float -> Float
+fy' sp@(V2 sx sy) ep@(V2 ex _) y
+    | sx == ex = sx
+    | otherwise = sx + xdy' sp ep * (y - sy)
+
+add2s :: IM.IntMap IS.IntSet -> [(Int,Int)] -> IM.IntMap IS.IntSet
+{-# INLINE add2s #-}
+add2s imis = foldl' 
+    (\m (k,x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
+    imis
+
+addV2s :: IM.IntMap IS.IntSet -> [V2 Int] -> IM.IntMap IS.IntSet
+{-# INLINE addV2s #-}
+addV2s imis = foldl' 
+    (\m (V2 k x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
+    imis
+
+pairsToIntMapSet :: [V2 Int] -> IM.IntMap IS.IntSet
+pairsToIntMapSet = foldl' 
+    (\m (V2 k x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
+    IM.empty