Bitmap/Midpoint circle algorithm
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).
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
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>
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>
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>