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 algol68>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 ) ( ))
D
Uses the second Image implementation. <lang d>import image: Color, Image;
void circle(Image img, int x0, int y0, int radius, Color color=Color.white) {
int f = 1 - radius; int ddf_x = 1; int ddf_y = -2 * radius; int x = 0; int y = radius; img[y0 + radius][x0] = color; img[y0 - radius][x0] = color; img[y0][x0 + radius] = color; img[y0][x0 - radius] = color;
while (x < y) { if (f >= 0) { y--; ddf_y += 2; f += ddf_y; } x++; ddf_x += 2; f += ddf_x; img[y0 + y][x0 + x] = color; img[y0 + y][x0 - x] = color; img[y0 - y][x0 + x] = color; img[y0 - y][x0 - x] = color; img[y0 + x][x0 + y] = color; img[y0 + x][x0 - y] = color; img[y0 - x][x0 + y] = color; img[y0 - x][x0 - y] = color; }
}
void main() {
auto img = new Image(25, 25); circle(img, 12, 12, 12); img.textView();
}</lang> Output:
.........#######......... .......##.......##....... .....##...........##..... ....#...............#.... ...#.................#... ..#...................#.. ..#...................#.. .#.....................#. .#.....................#. #.......................# #.......................# #.......................# #.......................# #.......................# #.......................# #.......................# .#.....................#. .#.....................#. ..#...................#.. ..#...................#.. ...#.................#... ....#...............#.... .....##...........##..... .......##.......##....... .........#######.........
Forth
<lang 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</lang>
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>
Haskell
The basic algorithm can be implemented generically. <lang haskell>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
</lang> An example using regular 2d arrays of characters to represent a bitmap: <lang haskell>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 </lang> Using the Image type from the Bitmap module defined here: <lang haskell>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
</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 , y , x 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 ~.,/ (y0,x0) +"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>
PL/I
<lang PL/I> /* Plot three circles. */
CIRCLE: PROCEDURE OPTIONS (MAIN);
declare image (-20:20, -20:20) character (1); declare j fixed binary;
image = '.'; image(0,*) = '-'; image(*,0) = '|'; image(0,0) = '+';
CALL DRAW_CIRCLE (0, 0, 11); CALL DRAW_CIRCLE (0, 0, 8); CALL DRAW_CIRCLE (0, 0, 19);
do j = hbound(image,1) to lbound(image,1) by -1; put skip edit (image(j,*)) (a(1)); end;
draw_circle: procedure (x0, y0, radius); /* 14 May 2010. */
declare ( x0, y0, radius ) fixed binary; declare ( ddfx, ddfy, x, y, f ) fixed binary; declare debug bit (1) aligned static initial ('0'b);
f = 1-radius; ddfx = 1; ddfy = -2*radius; x = 0; y = radius; image(x0, y0+radius) = '*'; /* Octet 0. */ image(x0+radius, y0) = '*'; /* Octet 1. */ image(x0, y0-radius) = '*'; /* Octet 2. */ image(x0-radius, y0) = '*'; /* Octet 3. */
do while (x < y); if f >= 0 then do; y = y - 1; ddfy = ddfy +2; f = f + ddfy; end; x = x + 1; ddfx = ddfx + 2; f = f + ddfx; image(x0+x, y0+y) = '0'; /* Draws octant 0. */ image(x0+y, y0+x) = '1'; /* Draws octant 1. */ image(x0+y, y0-x) = '2'; /* Draws octant 2. */ image(x0+x, y0-y) = '3'; /* Draws octant 3. */ image(x0-x, y0-y) = '4'; /* Draws octant 4. */ image(x0-y, y0-x) = '5'; /* Draws octant 5. */ image(x0-y, y0+x) = '6'; /* Draws octant 6. */ image(x0-x, y0+y) = '7'; /* Draws octant 7. */ end;
end draw_circle;
END CIRCLE; </lang> Output for three circles centered at the origin. <lang> ....................|.................... ................2222*1111................ .............222....|....111............. ...........22.......|.......11........... ..........2.........|.........1.......... ........22..........|..........11........ .......3............|............0....... ......2.............|.............1...... .....3..............|..............0..... .....3...........222*111...........0..... ....3..........22...|...11..........0.... ...3..........2.....|.....1..........0... ...3........32....22*11....11........0... ..3.........3...22..|..11...0.........0.. ..3........3...3....|....0...0........0.. ..3.......3...2.....|.....1...0.......0.. .3........3..3......|......0..0........0. .3.......3...3......|......0...0.......0. .3.......3..3.......|.......0..0.......0. .3.......3..3.......|.......0..0.......0. -*-------*--*-------+-------*--*-------*- .4.......4..4.......|.......7..7.......7. .4.......4..4.......|.......7..7.......7. .4.......4...4......|......7...7.......7. .4........4..4......|......7..7........7. ..4.......4...5.....|.....6...7.......7.. ..4........4...4....|....7...7........7.. ..4.........4...55..|..66...7.........7.. ...4........55....55*66....67........7... ...4..........5.....|.....6..........7... ....4..........55...|...66..........7.... .....4...........555*666...........7..... .....4..............|..............7..... ......5.............|.............6...... .......4............|............7....... ........55..........|..........66........ ..........5.........|.........6.......... ...........55.......|.......66........... .............555....|....666............. ................5555*6666................ ....................|.................... </lang>
PicoLisp
<lang PicoLisp>(de midPtCircle (Img CX CY Rad)
(let (F (- 1 Rad) DdFx 0 DdFy (* -2 Rad) X 0 Y Rad) (set (nth Img (+ CY Rad) CX) 1) (set (nth Img (- CY Rad) CX) 1) (set (nth Img CY (+ CX Rad)) 1) (set (nth Img CY (- CX Rad)) 1) (while (> Y X) (when (ge0 F) (dec 'Y) (inc 'F (inc 'DdFy 2)) ) (inc 'X) (inc 'F (inc (inc 'DdFx 2))) (set (nth Img (+ CY Y) (+ CX X)) 1) (set (nth Img (+ CY Y) (- CX X)) 1) (set (nth Img (- CY Y) (+ CX X)) 1) (set (nth Img (- CY Y) (- CX X)) 1) (set (nth Img (+ CY X) (+ CX Y)) 1) (set (nth Img (+ CY X) (- CX Y)) 1) (set (nth Img (- CY X) (+ CX Y)) 1) (set (nth Img (- CY X) (- CX Y)) 1) ) ) )
(let Img (make (do 120 (link (need 120 0)))) # Create image 120 x 120
(midPtCircle Img 60 60 50) # Draw circle (out "img.pbm" # Write to bitmap file (prinl "P1") (prinl 120 " " 120) (mapc prinl Img) ) )</lang>
PureBasic
<lang PureBasic>Procedure rasterCircle(cx, cy, r, Color)
;circle must lie completely within the image boundaries Protected f= 1 - r Protected ddF_X, ddF_Y = -2 * r Protected x, y = r Plot(cx, cy + r, Color) Plot(cx, cy - r, Color) Plot(cx + r, cy, Color) Plot(cx - r, cy, Color) While x < y If f >= 0 y - 1 ddF_Y + 2 f + ddF_Y EndIf x + 1 ddF_X + 2 f + ddF_X + 1 Plot(cx + x, cy + y, Color) Plot(cx - x, cy + y, Color) Plot(cx + x, cy - y, Color) Plot(cx - x, cy - y, Color) Plot(cx + y, cy + x, Color) Plot(cx - y, cy + x, Color) Plot(cx + y, cy - x, Color) Plot(cx - y, cy - x, Color) Wend
EndProcedure
OpenWindow(0, 0, 0, 100, 100, "MidPoint Circle Algorithm", #PB_Window_SystemMenu) CreateImage(0, 100, 100, 32) StartDrawing(ImageOutput(0))
Box(0, 0, 100, 100, RGB(0, 0, 0)) rasterCircle(25, 25, 20, RGB(255, 255, 255)) rasterCircle(50, 50, 40, RGB(255, 0, 0))
StopDrawing() ImageGadget(0, 0, 0, 0, 0, ImageID(0))
Repeat: Until WaitWindowEvent() = #PB_Event_CloseWindow</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>