B

Task/Bitmap-Midpoint-circle-algorithm/Haskell/bitmap-midpoint-circle-algorithm-1.hs

@@ -0,0 +1,28 @@
+module Circle where
+
+import Data.List
+
+type Point = (Int, Int)
+
+-- Takes the center of the circle and radius, and returns the circle points
+generateCirclePoints :: Point -> Int -> [Point]
+generateCirclePoints (x0, y0) radius
+  -- Four initial points, plus the generated points
+  = (x0, y0 + radius) : (x0, y0 - radius) : (x0 + radius, y0) : (x0 - radius, y0) : points
+    where
+      -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets.
+      points = concatMap generatePoints $ unfoldr step initialValues
+      generatePoints (x, y)
+        = [(xop x0 x', yop y0 y') | (x', y') <- [(x, y), (y, x)], xop <- [(+), (-)], yop <- [(+), (-)]]
+
+      -- The initial values for the loop
+      initialValues = (1 - radius, 1, (-2) * radius, 0, radius)
+
+      -- One step of the loop. The loop itself stops at Nothing.
+      step (f, ddf_x, ddf_y, x, y) | x >= y = Nothing
+                                   | otherwise = Just ((x', y'), (f', ddf_x', ddf_y', x', y'))
+                                     where
+                                       (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1)
+                                                        | otherwise = (f + ddf_x, ddf_y, y)
+                                       ddf_x' = ddf_x + 2
+                                       x' = x + 1

Task/Bitmap-Midpoint-circle-algorithm/Haskell/bitmap-midpoint-circle-algorithm-2.hs

@@ -0,0 +1,31 @@
+module CircleArrayExample where
+
+import Circle
+
+-- A surface is just a 2d array of characters for the purposes of this example
+type Colour = Char
+type Surface = Array (Int, Int) Colour
+
+-- Returns a surface of the given width and height filled with the colour
+blankSurface :: Int -> Int -> Colour -> Surface
+blankSurface width height filler = listArray bounds (repeat filler)
+  where
+    bounds = ((0, 0), (width - 1, height - 1))
+
+-- Generic plotting function. Plots points onto a surface with the given colour.
+plotPoints :: Surface -> Colour -> [Point] -> Surface
+plotPoints surface colour points = surface // zip points (repeat colour)
+
+-- Draws a circle of the given colour on the surface given a center and radius
+drawCircle :: Surface -> Colour -> Point -> Int -> Surface
+drawCircle surface colour center radius
+  = plotPoints surface colour (generateCirclePoints center radius)
+
+-- Converts a surface to a string
+showSurface image = unlines [[image ! (x, y) | x <- xRange] | y <- yRange]
+  where
+    ((xLow, yLow), (xHigh, yHigh)) = bounds image
+    (xRange, yRange) = ([xLow..xHigh], [yLow..yHigh])
+
+-- Converts a surface to a string and prints it
+printSurface = putStrLn . showSurface

Task/Bitmap-Midpoint-circle-algorithm/Haskell/bitmap-midpoint-circle-algorithm-3.hs

@@ -0,0 +1,11 @@
+module CircleBitmapExample where
+
+import Circle
+import Bitmap
+import Control.Monad.ST
+
+drawCircle :: (Color c) => Image s c -> c -> Point -> Int -> ST s (Image s c)
+drawCircle image colour center radius = do
+  let pixels = map Pixel (generateCirclePoints center radius)
+  forM_ pixels $ \pixel -> setPix image pixel colour
+  return image