Midpoint circle algorithm.

midpoint.hs

module Main where

-- | Get octant points for a circle of given radius.
octant :: (Num a, Ord a) => a -> [(a, a)]
octant r = takeWhile inOctant . map fst $ iterate step ((r, 0), 1 - r)
  where
    -- check if we are still in octant
    inOctant (x, y) = x >= y

    -- go to the next point in the circle
    step ((x, y), e)
      | e < 0     = ((x,     y + 1), e + 2 * (y + 1) + 1)
      | otherwise = ((x - 1, y + 1), e + 2 * (y - x + 2) + 1)

-- | Get quadrant points for a circle of given radius.
-- To do that we just mirror octant with respect to x = y line.
quadrant :: (Num a, Ord a) => a -> [(a, a)]
quadrant r = octant r >>= mirror
  where
    mirror (x, y) = [ (x, y), (y, x) ]

-- | Get points of a circle of given radius.
-- To do that we just mirror quadrant with respect to x = 0 and y = 0 lines.
circle :: (Num a, Ord a) => a -> [(a, a)]
circle r = quadrant r >>= mirror
  where
    mirror (x, y) = [ (u, v) | u <- [x, -x], v <- [y, -y] ]

-- | Move all points by a given vector.
translate :: Num a => (a, a) -> [(a, a)] -> [(a, a)]
translate v = map (v .+)

-- | Vector addition.
(.+) :: Num a => (a, a) -> (a, a) -> (a, a)
(x, y) .+ (u, v) = (x + u, y + v)

-- | Generate a rectangle display with
-- '.' for empty pixel and '@' for filled one.
display :: (Eq a, Enum a) => ((a, a), (a, a)) -> [(a, a)] -> IO ()
display ((l, t), (r, b)) ps = mapM_ putStrLn
  [ [ if (x, y) `elem` ps
        then '@'
        else '.'
    | x <- [l .. r] ]
  | y <- [t .. b] ]

main :: IO ()
main = do
  let -- a couple of circles
      circles =
        [ translate (7,  12) (circle 5)
        , translate (29,  5) (circle 7)
        , translate (15, 15) (circle 10) ]
      -- display rectangle bounds
      rect = ((0, 0), (30, 30))

  -- display circles
  display rect (concat circles)