diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 3e3e00c77..2a081b9d7 100644 --- a/src/Dodge/Base.hs +++ b/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 diff --git a/src/Geometry.hs b/src/Geometry.hs index 4b1fc1a78..e80722f8e 100644 --- a/src/Geometry.hs +++ 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