Bitmap/Midpoint circle algorithm

You are encouraged to solve this task according to the task description, using any language you may know.
Using the data storage type defined on this page for raster images, write an implementation of the midpoint circle algorithm (also known as Bresenham's circle algorithm).
Ada
<lang ada> procedure Circle
( Picture : in out Image; Center : Point; Radius : Natural; Color : Pixel ) is F : Integer := 1 - Radius; ddF_X : Integer := 0; ddF_Y : Integer := -2 * Radius; X : Integer := 0; Y : Integer := Radius;
begin
Picture (Center.X, Center.Y + Radius) := Color; Picture (Center.X, Center.Y - Radius) := Color; Picture (Center.X + Radius, Center.Y) := Color; Picture (Center.X - Radius, Center.Y) := Color; while X < Y loop if F >= 0 then Y := Y - 1; ddF_Y := ddF_Y + 2; F := F + ddF_Y; end if; X := X + 1; ddF_X := ddF_X + 2; F := F + ddF_X + 1; Picture (Center.X + X, Center.Y + Y) := Color; Picture (Center.X - X, Center.Y + Y) := Color; Picture (Center.X + X, Center.Y - Y) := Color; Picture (Center.X - X, Center.Y - Y) := Color; Picture (Center.X + Y, Center.Y + X) := Color; Picture (Center.X - Y, Center.Y + X) := Color; Picture (Center.X + Y, Center.Y - X) := Color; Picture (Center.X - Y, Center.Y - X) := Color; end loop;
end Circle; </lang> The following illustrates use: <lang ada>
X : Image (1..16, 1..16);
begin
Fill (X, White); Circle (X, (8, 8), 5, Black); Print (X);
</lang> Sample output:
HHHHH H H H H H H H H H H H H H H H H H H HHHHH
ALGOL 68
<lang>PRAGMAT READ "Basic_bitmap_storage.a68" PRAGMAT;
circle OF class image :=
( REF IMAGE picture, POINT center, INT radius, PIXEL color )VOID:
BEGIN
INT f := 1 - radius, POINT ddf := (0, -2 * radius), df := (0, radius); picture [x OF center, y OF center + radius] := picture [x OF center, y OF center - radius] := picture [x OF center + radius, y OF center] := picture [x OF center - radius, y OF center] := color; WHILE x OF df < y OF df DO IF f >= 0 THEN y OF df -:= 1; y OF ddf +:= 2; f +:= y OF ddf FI; x OF df +:= 1; x OF ddf +:= 2; f +:= x OF ddf + 1; picture [x OF center + x OF df, y OF center + y OF df] := picture [x OF center - x OF df, y OF center + y OF df] := picture [x OF center + x OF df, y OF center - y OF df] := picture [x OF center - x OF df, y OF center - y OF df] := picture [x OF center + y OF df, y OF center + x OF df] := picture [x OF center - y OF df, y OF center + x OF df] := picture [x OF center + y OF df, y OF center - x OF df] := picture [x OF center - y OF df, y OF center - x OF df] := color OD
END # circle #;
The following illustrates use:
IF test THEN
REF IMAGE x = INIT LOC [1:16, 1:16] PIXEL; (fill OF class image)(x, (white OF class image)); (circle OF class image)(x, (8, 8), 5, (black OF class image)); (print OF class image)(x)
FI</lang> Output:
ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffff000000000000000000000000000000ffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffff000000ffffffffffffffffffffffffffffff000000ffffffffffffffffffffffffffffff ffffffffffffffffff000000ffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffffffffff000000ffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffffffffff ffffffffffffffffffffffff000000ffffffffffffffffffffffffffffff000000ffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffff000000000000000000000000000000ffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
C
Interface:
<lang c>void raster_circle(
image img, unsigned int x0, unsigned int y0, unsigned int radius, color_component r, color_component g, color_component b );</lang>
Implementation:
<lang c>#define plot(x, y) put_pixel_clip(img, x, y, r, g, b)
void raster_circle(
image img, unsigned int x0, unsigned int y0, unsigned int radius, color_component r, color_component g, color_component b )
{
int f = 1 - radius; int ddF_x = 0; int ddF_y = -2 * radius; int x = 0; int y = radius;
plot(x0, y0 + radius); plot(x0, y0 - radius); plot(x0 + radius, y0); plot(x0 - radius, y0);
while(x < y) { if(f >= 0) { y--; ddF_y += 2; f += ddF_y; } x++; ddF_x += 2; f += ddF_x + 1; plot(x0 + x, y0 + y); plot(x0 - x, y0 + y); plot(x0 + x, y0 - y); plot(x0 - x, y0 - y); plot(x0 + y, y0 + x); plot(x0 - y, y0 + x); plot(x0 + y, y0 - x); plot(x0 - y, y0 - x); }
}
- undef plot</lang>
Common Lisp
Based upon the OCaml version.
<lang lisp>(defun draw-circle (draw-function x0 y0 radius)
(labels ((foo (x y) (funcall draw-function x y)) (put (x y m) (let ((x+ (+ x0 x)) (x- (- x0 x)) (y+ (+ y0 y)) (y- (- y0 y)) (x0y+ (+ x0 y)) (x0y- (- x0 y)) (xy0+ (+ y0 x)) (xy0- (- y0 x))) (foo x+ y+) (foo x+ y-) (foo x- y+) (foo x- y-) (foo x0y+ xy0+) (foo x0y+ xy0-) (foo x0y- xy0+) (foo x0y- xy0-) (multiple-value-bind (y m) (if (plusp m) (values (1- y) (- m (* 8 y))) (values y m)) (when (<= x y) (put (1+ x) y (+ m 4 (* 8 x)))))))) (put 0 radius (- 5 (* 4 radius))) (values)))</lang>
<lang lisp>CL-USER> (let ((buffer (make-array '(30 30)
:element-type 'bit))) (draw-circle (lambda (x y) (setf (bit buffer x y) 1)) 15 15 10) buffer)</lang>
;; edited for your convenience (( ) ( 1 1 1 1 1 1 1 ) ( 1 1 1 1 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 ) ( 1 1 1 1 1 1 ) ( 1 1 1 1 1 1 1 ) ( ))
Forth
: circle { x y r color bmp -- } 1 r - 0 r 2* negate 0 r { f ddx ddy dx dy } color x y r + bmp b! color x y r - bmp b! color x r + y bmp b! color x r - y bmp b! begin dx dy < while f 0< 0= if dy 1- to dy ddy 2 + dup to ddy f + to f then dx 1+ to dx ddx 2 + dup to ddx f 1+ + to f color x dx + y dy + bmp b! color x dx - y dy + bmp b! color x dx + y dy - bmp b! color x dx - y dy - bmp b! color x dy + y dx + bmp b! color x dy - y dx + bmp b! color x dy + y dx - bmp b! color x dy - y dx - bmp b! repeat ;
12 12 bitmap value test 0 test bfill 6 6 5 blue test circle test bshow cr
Fortran
This code should be inside RCImagePrimitive (see here). The private subroutine draw_circle_toch
, which writes to a channel, is used by both draw_circle_rgb
and draw_circle_sc
and the interface allows to use draw_circle
with rgb images and grayscale images.
<lang fortran> interface draw_circle
module procedure draw_circle_sc, draw_circle_rgb end interface
private :: plot, draw_circle_toch</lang>
<lang fortran> subroutine plot(ch, p, v)
integer, dimension(:,:), intent(out) :: ch type(point), intent(in) :: p integer, intent(in) :: v
integer :: cx, cy ! I've kept the default 1-based array, but top-left corner pixel ! is labelled as (0,0). cx = p%x + 1 cy = p%y + 1
if ( (cx > 0) .and. (cx <= ubound(ch,1)) .and. & (cy > 0) .and. (cy <= ubound(ch,2)) ) then ch(cx,cy) = v end if end subroutine plot subroutine draw_circle_toch(ch, c, radius, v) integer, dimension(:,:), intent(out) :: ch type(point), intent(in) :: c integer, intent(in) :: radius, v
integer :: f, ddf_x, ddf_y, x, y
f = 1 - radius ddf_x = 0 ddf_y = -2 * radius x = 0 y = radius
call plot(ch, point(c%x, c%y + radius), v) call plot(ch, point(c%x, c%y - radius), v) call plot(ch, point(c%x + radius, c%y), v) call plot(ch, point(c%x - radius, c%y), v)
do while ( x < y ) if ( f >= 0 ) then y = y - 1 ddf_y = ddf_y + 2 f = f + ddf_y end if x = x + 1 ddf_x = ddf_x + 2 f = f + ddf_x + 1 call plot(ch, point(c%x + x, c%y + y), v) call plot(ch, point(c%x - x, c%y + y), v) call plot(ch, point(c%x + x, c%y - y), v) call plot(ch, point(c%x - x, c%y - y), v) call plot(ch, point(c%x + y, c%y + x), v) call plot(ch, point(c%x - y, c%y + x), v) call plot(ch, point(c%x + y, c%y - x), v) call plot(ch, point(c%x - y, c%y - x), v) end do end subroutine draw_circle_toch
subroutine draw_circle_rgb(img, c, radius, color) type(rgbimage), intent(out) :: img type(point), intent(in) :: c integer, intent(in) :: radius type(rgb), intent(in) :: color call draw_circle_toch(img%red, c, radius, color%red) call draw_circle_toch(img%green, c, radius, color%green) call draw_circle_toch(img%blue, c, radius, color%blue) end subroutine draw_circle_rgb
subroutine draw_circle_sc(img, c, radius, lum) type(scimage), intent(out) :: img type(point), intent(in) :: c integer, intent(in) :: radius, lum call draw_circle_toch(img%channel, c, radius, lum) end subroutine draw_circle_sc</lang>
J
Solution:
Using definitions from Basic bitmap storage.
<lang j>NB.*getBresenhamCircle v Returns points for a circle given center and radius
NB. y is: y0 x0 radius
getBresenhamCircle=: monad define
'y0 x0 radius'=. y x=. 0 y=. radius f=. -. radius pts=. 0 2$0 while. x <: y do. pts=. pts , x , y if. f >: 0 do. y=. <:y f=. f + _2 * y end. x=. >:x f =. f + >: 2 * x end. offsets=. (,|."1) (1 _1 {~ #: i.4) *"1"1 _ pts ~.,/ (x0,y0) +"1 offsets
)
NB.*drawCircles v Draws circle(s) (x) on image (y) NB. x is: 2-item list of boxed (y0 x0 radius) ; (color) drawCircles=: (1&{:: ;~ [: ; [: <@getBresenhamCircle"1 (0&{::))@[ setPixels ] </lang>
Example usage: <lang j> myimg=: 0 255 0 makeRGB 25 25 NB. 25 by 25 green image
myimg=: (12 12 12 ; 255 0 0) drawCircles myimg NB. draw red circle with radius 12 viewRGB ((12 12 9 ,: 12 12 6) ; 0 0 255) drawCircles myimg NB. draw two more concentric circles
</lang>
Modula-3
<lang modula3>INTERFACE Circle;
IMPORT Bitmap;
PROCEDURE Draw(
img: Bitmap.T; center: Bitmap.Point; radius: CARDINAL; color: Bitmap.Pixel);
END Circle.</lang> <lang modula3>MODULE Circle;
IMPORT Bitmap;
PROCEDURE Draw(
img: Bitmap.T; center: Bitmap.Point; radius: CARDINAL; color: Bitmap.Pixel) = VAR f := 1 - radius; ddfx := 0; ddfy := - 2 * radius; x := 0; y := radius; BEGIN Bitmap.SetPixel(img, Bitmap.Point{center.x, center.y + radius}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x, center.y - radius}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x + radius, center.y}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x - radius, center.y}, color); WHILE x < y DO IF f >= 0 THEN y := y - 1; ddfy := ddfy + 2; f := f + ddfy; END; x := x + 1; ddfx := ddfx + 2; f := f + ddfx + 1; Bitmap.SetPixel(img, Bitmap.Point{center.x + x, center.y + y}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x - x, center.y + y}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x + x, center.y - y}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x - x, center.y - y}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x + y, center.y + x}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x - y, center.y + x}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x + y, center.y - x}, color); Bitmap.SetPixel(img, Bitmap.Point{center.x - y, center.y - x}, color); END; END Draw;
BEGIN END Circle.</lang>
Example (outputs a PPM image): <lang modula3>MODULE Main;
IMPORT Circle, Bitmap, PPM;
VAR testpic: Bitmap.T;
BEGIN
testpic := Bitmap.NewImage(32, 32); Bitmap.Fill(testpic, Bitmap.White); Circle.Draw(testpic, Bitmap.Point{16, 16}, 10, Bitmap.Black); PPM.Create("testpic.ppm", testpic);
END Main.</lang>
OCaml
<lang ocaml>let raster_circle ~img ~color ~c:(x0, y0) ~r =
let plot = put_pixel img color in let x = 0 and y = r and m = 5 - 4 * r in let rec loop x y m = plot (x0 + x) (y0 + y); plot (x0 + y) (y0 + x); plot (x0 - x) (y0 + y); plot (x0 - y) (y0 + x); plot (x0 + x) (y0 - y); plot (x0 + y) (y0 - x); plot (x0 - x) (y0 - y); plot (x0 - y) (y0 - x); let y, m = if m > 0 then (y - 1), (m - 8 * y) else y, m in if x <= y then let x = x + 1 in let m = m + 8 * x + 4 in loop x y m in loop x y m
- </lang>
Python
Extending the example given here <lang python>def circle(self, x0, y0, radius, colour=black):
f = 1 - radius ddf_x = 1 ddf_y = -2 * radius x = 0 y = radius self.set(x0, y0 + radius, colour) self.set(x0, y0 - radius, colour) self.set(x0 + radius, y0, colour) self.set(x0 - radius, y0, colour)
while x < y: if f >= 0: y -= 1 ddf_y += 2 f += ddf_y x += 1 ddf_x += 2 f += ddf_x self.set(x0 + x, y0 + y, colour) self.set(x0 - x, y0 + y, colour) self.set(x0 + x, y0 - y, colour) self.set(x0 - x, y0 - y, colour) self.set(x0 + y, y0 + x, colour) self.set(x0 - y, y0 + x, colour) self.set(x0 + y, y0 - x, colour) self.set(x0 - y, y0 - x, colour)
Bitmap.circle = circle
bitmap = Bitmap(25,25) bitmap.circle(x0=12, y0=12, radius=12) bitmap.chardisplay()
The origin, 0,0; is the lower left, with x increasing to the right, and Y increasing upwards.
The program above produces the following display :
+-------------------------+ | @@@@@@@ | | @@ @@ | | @@ @@ | | @ @ | | @ @ | | @ @ | | @ @ | | @ @ | | @ @ | |@ @| |@ @| |@ @| |@ @| |@ @| |@ @| |@ @| | @ @ | | @ @ | | @ @ | | @ @ | | @ @ | | @ @ | | @@ @@ | | @@ @@ | | @@@@@@@ | +-------------------------+
</lang>
Ruby
<lang ruby>Pixel = Struct.new(:x, :y)
class Pixmap
def draw_circle(pixel, radius, colour) validate_pixel(pixel.x, pixel.y) self[pixel.x, pixel.y + radius] = colour self[pixel.x, pixel.y - radius] = colour self[pixel.x + radius, pixel.y] = colour self[pixel.x - radius, pixel.y] = colour f = 1 - radius ddF_x = 1 ddF_y = -2 * radius x = 0 y = radius while x < y if f >= 0 y -= 1 ddF_y += 2 f += ddF_y end x += 1 ddF_x += 2 f += ddF_x self[pixel.x + x, pixel.y + y] = colour self[pixel.x + x, pixel.y - y] = colour self[pixel.x - x, pixel.y + y] = colour self[pixel.x - x, pixel.y - y] = colour self[pixel.x + y, pixel.y + x] = colour self[pixel.x + y, pixel.y - x] = colour self[pixel.x - y, pixel.y + x] = colour self[pixel.x - y, pixel.y - x] = colour end end
end
bitmap = Pixmap.new(30, 30) bitmap.draw_circle(Pixel[14,14], 12, RGBColour::BLACK)</lang>
Tcl
ref Basic bitmap storage#Tcl and Assertions#Tcl <lang tcl>package require Tcl 8.5 package require Tk
proc drawCircle {image colour point radius} {
lassign $point x0 y0
setPixel $image $colour [list $x0 [expr {$y0 + $radius}]] setPixel $image $colour [list $x0 [expr {$y0 - $radius}]] setPixel $image $colour [list [expr {$x0 + $radius}] $y0] setPixel $image $colour [list [expr {$x0 - $radius}] $y0]
set f [expr {1 - $radius}] set ddF_x 1 set ddF_y [expr {-2 * $radius}] set x 0 set y $radius while {$x < $y} { assert {$ddF_x == 2 * $x + 1} assert {$ddF_y == -2 * $y} assert {$f == $x*$x + $y*$y - $radius*$radius + 2*$x - $y + 1} if {$f >= 0} { incr y -1 incr ddF_y 2 incr f $ddF_y } incr x incr ddF_x 2 incr f $ddF_x setPixel $image $colour [list [expr {$x0 + $x}] [expr {$y0 + $y}]] setPixel $image $colour [list [expr {$x0 - $x}] [expr {$y0 + $y}]] setPixel $image $colour [list [expr {$x0 + $x}] [expr {$y0 - $y}]] setPixel $image $colour [list [expr {$x0 - $x}] [expr {$y0 - $y}]] setPixel $image $colour [list [expr {$x0 + $y}] [expr {$y0 + $x}]] setPixel $image $colour [list [expr {$x0 - $y}] [expr {$y0 + $x}]] setPixel $image $colour [list [expr {$x0 + $y}] [expr {$y0 - $x}]] setPixel $image $colour [list [expr {$x0 - $y}] [expr {$y0 - $x}]]
}
}
- create the image and display it
set img [newImage 200 100] label .l -image $img pack .l
fill $img black drawCircle $img blue {100 50} 49</lang>
Vedit macro language
<lang vedit> // Draw a circle using Bresenham's circle algorithm. // #21 = center x, #22 = center y; #23 = radius
- DRAW_CIRCLE:
- 30 = 1 - #23 // f
- 31 = 0 // ddF_x
- 32 = -2 * #23 // ddF_y
- 41 = 0 // x
- 42 = #23 // y
while (#41 <= #42) {
#1 = #21+#41; #2 = #22+#42; Call("DRAW_PIXEL") #1 = #21-#41; #2 = #22+#42; Call("DRAW_PIXEL") #1 = #21+#41; #2 = #22-#42; Call("DRAW_PIXEL") #1 = #21-#41; #2 = #22-#42; Call("DRAW_PIXEL") #1 = #21+#42; #2 = #22+#41; Call("DRAW_PIXEL") #1 = #21-#42; #2 = #22+#41; Call("DRAW_PIXEL") #1 = #21+#42; #2 = #22-#41; Call("DRAW_PIXEL") #1 = #21-#42; #2 = #22-#41; Call("DRAW_PIXEL") if (#30 >= 0) {
#42-- #32 += 2 #30 += #32
} #41++ #31 += 2 #30 += #31 + 1
}
return </lang>