Replace bresenham with digitalLine

src/Dodge/Base.hs

@@ -275,19 +275,19 @@ zoneAroundPoint' i (x',y') = IM.fromSet (const ys) xs
 -- if this reoccurs, maybe change
 -- divide line factor from 2 to 1.5
 bres :: Point2 -> Point2 -> [(Int,Int)]
-bres a b = bresenham (zoneOfPoint a) (zoneOfPoint b)
+bres a b = digitalLine (zoneOfPoint a) (zoneOfPoint b)
 
 bresx :: Point2 -> Point2 -> [(Int,Int)]
-bresx a b = bresenham (x-1,y-1) (x'-1,y'-1)
+bresx a b = digitalLine (x-1,y-1) (x'-1,y'-1)
     where (x,y) = zoneOfPoint a
           (x',y') = zoneOfPoint b
 
 zoneOfLine :: Point2 -> Point2 -> [(Int,Int)]
 zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f 
-                                 $ bresenham (zoneOfPoint (aa,ab)) (zoneOfPoint (ba,bb))
+                                 $ digitalLine (zoneOfPoint (aa,ab)) (zoneOfPoint (ba,bb))
     where f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
 --zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f 
---                                 $ bresenham (zoneOfPoint (aa-n,ab-n)) (zoneOfPoint (ba-n,bb-n))
+--                                 $ digitalLine (zoneOfPoint (aa-n,ab-n)) (zoneOfPoint (ba-n,bb-n))
 --    where f (x,y) = [(p,r) | p <-[x,x+1] , r<-[y,y+1]]
 --          n = zoneSize * 0.5
 
@@ -302,7 +302,7 @@ expandLine xs = IM.map expandSet
 
 zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet
 {-# INLINE zoneOfLine' #-}
-zoneOfLine' a b = expandLine $ bresenham (x-1,y-1) (x'-1,y'-1)
+zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
     where (x,y) = zoneOfPoint a
           (x',y') = zoneOfPoint b
                         

src/Geometry.hs

@@ -297,6 +297,7 @@ divideLine x a b = take 5000 $ map (\i -> a +.+ (i / (fromIntegral numPoints) *.
 
 
 -- pulled the following from the haskell wiki
+-- it seems to produce an infinite loop sometimes
 bresenham :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
 {-# INLINE bresenham #-}
 bresenham pa@(xa,ya) pb@(xb,yb) = map maySwitch . unfoldr go $ (x1,y1,0)
@@ -316,6 +317,18 @@ bresenham pa@(xa,ya) pb@(xb,yb) = map maySwitch . unfoldr go $ (x1,y1,0)
                             then (yTemp+ystep,tempError-deltax)
                             else (yTemp,tempError)
 
+digitalLine :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
+digitalLine (x1,y1) (x2,y2) 
+    | abs (x1-x2) > abs (y1-y2) = [ (x,( (y1-y2) * x + x1*y2 - x2*y1) `rdiv` (x1-x2) ) 
+                                    | x <- intervalList x1 x2 ]
+    | otherwise                 = [ ( ((x1-x2) * y + y1*x2 - y2*x1) `rdiv` (y1-y2)  , y)
+                                    | y <- intervalList y1 y2 ]
+        where rdiv a b = round $ fromIntegral a / fromIntegral b
+
+intervalList :: Int -> Int -> [Int]
+intervalList x y 
+    | y >= x = [x .. y]
+    | otherwise = reverse [y..x]
 
 divideCircle :: Float -> Point2 -> Float -> [Point2]
 divideCircle x cen rad = map (cen +.+) $ nPointsOnCirc n rad