Bitmap/Midpoint circle algorithm: Difference between revisions
Updated D entry |
Added zkl |
||
Line 1,519: | Line 1,519: | ||
SetVid(3); \restore normal text mode |
SetVid(3); \restore normal text mode |
||
]</lang> |
]</lang> |
||
=={{header|zkl}}== |
|||
Image cribbed from the BBC BASIC entry. Algorithm from Wikipedia article. |
|||
[[Image:circle_bbc.gif|right]] |
|||
<lang zkl>class PPM{ |
|||
fcn init(width,height,rgb=0){ |
|||
sz:=width*height; |
|||
var [const] |
|||
data=sz.pump(Data(sz*3),T(Void,rgb.toBigEndian(3))), // initialize to Black (RGB=000) |
|||
w=width, h=height; |
|||
} |
|||
fcn fill(rgb){ |
|||
sz:=data.len()/3; |
|||
data.clear(); sz.pump(data,T(Void,rgb.toBigEndian(3))); |
|||
} |
|||
fcn __sGet(x,y){ data.toBigEndian(y*w*3 + x,3); } //ppm[x,y] |
|||
fcn __sSet(rbg,x,y){ data[y*w*3 + x*3,3]=rbg.toBigEndian(3); } //ppm[x,y]=rgb |
|||
fcn write(out){ |
|||
out.write("P6\n#rosettacode PPM\n%d %d\n255\n".fmt(w,h)); |
|||
out.write(data); |
|||
} |
|||
fcn circle(x0,y0,r,rgb){ |
|||
x:=r; y:=0; radiusError:=1-x; |
|||
while(x >= y){ |
|||
__sSet(rgb, x + x0, y + y0); |
|||
__sSet(rgb, y + x0, x + y0); |
|||
__sSet(rgb,-x + x0, y + y0); |
|||
__sSet(rgb,-y + x0, x + y0); |
|||
self[-x + x0, -y + y0]=rgb; // or do it this way, __sSet gets called as above |
|||
self[-y + x0, -x + y0]=rgb; |
|||
self[ x + x0, -y + y0]=rgb; |
|||
self[ y + x0, -x + y0]=rgb; |
|||
y+=1; |
|||
if (radiusError<0) radiusError+=2*y + 1; |
|||
else{ x-=1; radiusError+=2*(y - x + 1); } |
|||
} |
|||
} |
|||
}</lang> |
|||
<lang zkl>ppm:=PPM(200,200,0xFF|FF|FF); |
|||
ppm.circle(100,100,40,00); // black circle |
|||
ppm.circle(100,100,80,0xFF|00|00); // red circle |
|||
ppm.write(File("foo.ppm","wb"));</lang> |
|||
{{omit from|PARI/GP}} |
{{omit from|PARI/GP}} |
Revision as of 19:58, 30 August 2014
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
File: prelude/Bitmap/Midpoint_circle_algorithm.a68<lang algol68># -*- coding: utf-8 -*- #
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 #;
SKIP</lang>File: test/Bitmap/Midpoint_circle_algorithm.a68<lang algol68>#!/usr/bin/a68g --script #
- -*- coding: utf-8 -*- #
PR READ "prelude/Bitmap.a68" PR; # c.f. rc:Bitmap # PR READ "prelude/Bitmap/Bresenhams_line_algorithm.a68" PR; # c.f. rc:Bitmap/Bresenhams_line_algorithm # PR READ "prelude/Bitmap/Midpoint_circle_algorithm.a68" PR;
- The following illustrates use: #
test:(
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)
)</lang> Output:
ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffff000000000000000000000000000000ffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffff000000ffffffffffffffffffffffffffffff000000ffffffffffffffffffffffffffffff ffffffffffffffffff000000ffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffff000000ffffffffffffffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffff ffffffffffffffffff000000ffffffffffffffffffffffffffffffffffffffffff000000ffffffffffffffffffffffff ffffffffffffffffffffffff000000ffffffffffffffffffffffffffffff000000ffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffff000000000000000000000000000000ffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
BBC BASIC
<lang bbcbasic> Width% = 200
Height% = 200 REM Set window size: VDU 23,22,Width%;Height%;8,16,16,128 REM Draw circles: PROCcircle(100,100,40, 0,0,0) PROCcircle(100,100,80, 255,0,0) END DEF PROCcircle(cx%,cy%,r%,R%,G%,B%) LOCAL f%, x%, y%, ddx%, ddy% f% = 1 - r% : y% = r% : ddy% = - 2*r% PROCsetpixel(cx%, cy%+r%, R%,G%,B%) PROCsetpixel(cx%, cy%-r%, R%,G%,B%) PROCsetpixel(cx%+r%, cy%, R%,G%,B%) PROCsetpixel(cx%-r%, cy%, R%,G%,B%) WHILE x% < y% IF f% >= 0 THEN y% -= 1 ddy% += 2 f% += ddy% ENDIF x% += 1 ddx% += 2 f% += ddx% + 1 PROCsetpixel(cx%+x%, cy%+y%, R%,G%,B%) PROCsetpixel(cx%-x%, cy%+y%, R%,G%,B%) PROCsetpixel(cx%+x%, cy%-y%, R%,G%,B%) PROCsetpixel(cx%-x%, cy%-y%, R%,G%,B%) PROCsetpixel(cx%+y%, cy%+x%, R%,G%,B%) PROCsetpixel(cx%-y%, cy%+x%, R%,G%,B%) PROCsetpixel(cx%+y%, cy%-x%, R%,G%,B%) PROCsetpixel(cx%-y%, cy%-x%, R%,G%,B%) ENDWHILE ENDPROC DEF PROCsetpixel(x%,y%,r%,g%,b%) COLOUR 1,r%,g%,b% GCOL 1 LINE x%*2,y%*2,x%*2,y%*2 ENDPROC</lang>
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>
C#
This extension method extends GenericImage which is very similar to Bitmap but instead of using a SetPixel method it uses a "Color this[int x, int y] { get; set; }" property to get and set pixels.
<lang csharp>
/// <summary> /// Draws a circle. /// </summary> /// <param name="image"> /// The destination image. /// </param> /// <param name="centerX"> /// The x center position of the circle. /// </param> /// <param name="centerY"> /// The y center position of the circle. /// </param> /// <param name="radius"> /// The radius of the circle. /// </param> /// <param name="color"> /// The color to use. /// </param> public static void DrawCircle(this GenericImage image, int centerX, int centerY, int radius, Color color) { int d = (5 - radius * 4) / 4; int x = 0; int y = radius;
do { // ensure index is in range before setting (depends on your image implementation) // in this case we check if the pixel location is within the bounds of the image before setting the pixel if (centerX + x >= 0 && centerX + x <= image.Width - 1 && centerY + y >= 0 && centerY + y <= image.Height - 1) image[centerX + x, centerY + y] = color; if (centerX + x >= 0 && centerX + x <= image.Width - 1 && centerY - y >= 0 && centerY - y <= image.Height - 1) image[centerX + x, centerY - y] = color; if (centerX - x >= 0 && centerX - x <= image.Width - 1 && centerY + y >= 0 && centerY + y <= image.Height - 1) image[centerX - x, centerY + y] = color; if (centerX - x >= 0 && centerX - x <= image.Width - 1 && centerY - y >= 0 && centerY - y <= image.Height - 1) image[centerX - x, centerY - y] = color; if (centerX + y >= 0 && centerX + y <= image.Width - 1 && centerY + x >= 0 && centerY + x <= image.Height - 1) image[centerX + y, centerY + x] = color; if (centerX + y >= 0 && centerX + y <= image.Width - 1 && centerY - x >= 0 && centerY - x <= image.Height - 1) image[centerX + y, centerY - x] = color; if (centerX - y >= 0 && centerX - y <= image.Width - 1 && centerY + x >= 0 && centerY + x <= image.Height - 1) image[centerX - y, centerY + x] = color; if (centerX - y >= 0 && centerX - y <= image.Width - 1 && centerY - x >= 0 && centerY - x <= image.Height - 1) image[centerX - y, centerY - x] = color; if (d < 0) { d += 2 * x + 1; } else { d += 2 * (x - y) + 1; y--; } x++; } while (x <= y); }
</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 bitmap module from the Bitmap Task. <lang d>import bitmap: Image, RGB;
void circle(Color)(Image!Color img, in int x0, in int y0,
in int radius, in Color color) pure nothrow @nogc { int f = 1 - radius; int ddfX = 1; int ddfY = -2 * radius; int x = 0; int y = radius; img[x0, y0 + radius] = color; img[x0, y0 - radius] = color; img[x0 + radius, y0] = color; img[x0 - radius, y0] = color;
while (x < y) { if (f >= 0) { y--; ddfY += 2; f += ddfY; } x++; ddfX += 2; f += ddfX; img[x0 + x, y0 + y] = color; img[x0 - x, y0 + y] = color; img[x0 + x, y0 - y] = color; img[x0 - x, y0 - y] = color; img[x0 + y, y0 + x] = color; img[x0 - y, y0 + x] = color; img[x0 + y, y0 - x] = color; img[x0 - y, y0 - x] = color; }
}
void main() {
auto img = new Image!RGB(25, 25); img.clear(RGB.white); circle(img, 12, 12, 12, RGB.black); img.textualShow;
}</lang>
- Output:
.........#######......... .......##.......##....... .....##...........##..... ....#...............#.... ...#.................#... ..#...................#.. ..#...................#.. .#.....................#. .#.....................#. #.......................# #.......................# #.......................# #.......................# #.......................# #.......................# #.......................# .#.....................#. .#.....................#. ..#...................#.. ..#...................#.. ...#.................#... ....#...............#.... .....##...........##..... .......##.......##....... .........#######.........
FBSL
Using pure FBSL's built-in graphics functions: <lang qbasic>#DEFINE WM_LBUTTONDOWN 513
- DEFINE WM_CLOSE 16
FBSLSETTEXT(ME, "Bresenham Circle") ' Set form caption FBSLSETFORMCOLOR(ME, RGB(0, 255, 255)) ' Cyan: persistent background color FBSL.GETDC(ME) ' Use volatile FBSL.GETDC below to avoid extra assignments
RESIZE(ME, 0, 0, 220, 220) CENTER(ME) SHOW(ME)
DIM Breadth AS INTEGER, Height AS INTEGER FBSL.GETCLIENTRECT(ME, 0, 0, Breadth, Height)
BEGIN EVENTS ' Main message loop SELECT CASE CBMSG CASE WM_LBUTTONDOWN: MidpointCircle() ' Draw CASE WM_CLOSE: FBSL.RELEASEDC(ME, FBSL.GETDC) ' Clean up END SELECT END EVENTS
SUB MidpointCircle() BresenhamCircle(Breadth \ 2, Height \ 2, 80, &HFF) ' Red: Windows stores colors in BGR order BresenhamCircle(Breadth \ 2, Height \ 2, 40, 0) ' Black
SUB BresenhamCircle(cx, cy, radius, colour) DIM x = 0, y = radius, f = 1 - radius, dx = 0, dy = -2 * radius
PSET(FBSL.GETDC, cx, cy + radius, colour)(FBSL.GETDC, cx, cy - radius, colour) PSET(FBSL.GETDC, cx + radius, cy, colour)(FBSL.GETDC, cx - radius, cy, colour)
WHILE x < y IF f >= 0 THEN: DECR(y): INCR(dy, 2)(f, dy): END IF ' Try also "IF f THEN" :) INCR(x)(dx, 2)(f, dx + 1) PSET(FBSL.GETDC, cx + x, cy + y, colour)(FBSL.GETDC, cx - x, cy + y, colour) PSET(FBSL.GETDC, cx + x, cy - y, colour)(FBSL.GETDC, cx - x, cy - y, colour) PSET(FBSL.GETDC, cx + y, cy + x, colour)(FBSL.GETDC, cx - y, cy + x, colour) PSET(FBSL.GETDC, cx + y, cy - x, colour)(FBSL.GETDC, cx - y, cy - x, colour) WEND END SUB END SUB</lang> Ouptut:
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>
Go
This produces identical results to the C code in the WP article, but with more compact code. <lang go>package raster
// Circle plots a circle with center x, y and radius r. // Limiting behavior: // r < 0 plots no pixels. // r = 0 plots a single pixel at x, y. // r = 1 plots four pixels in a diamond shape around the center pixel at x, y. func (b *Bitmap) Circle(x, y, r int, p Pixel) {
if r < 0 { return } // Bresenham algorithm x1, y1, err := -r, 0, 2-2*r for { b.SetPx(x-x1, y+y1, p) b.SetPx(x-y1, y-x1, p) b.SetPx(x+x1, y-y1, p) b.SetPx(x+y1, y+x1, p) r = err if r > x1 { x1++ err += x1*2 + 1 } if r <= y1 { y1++ err += y1*2 + 1 } if x1 >= 0 { break } }
}
func (b *Bitmap) CircleRgb(x, y, r int, c Rgb) {
b.Circle(x, y, r, c.Pixel())
}</lang> Demonstration program: <lang>package main
// Files required to build supporting package raster are found in: // * This task (immediately above) // * Bitmap // * Write a PPM file
import (
"raster" "fmt"
)
func main() {
b := raster.NewBitmap(400, 300) b.FillRgb(0xffdf20) // yellow // large circle, demonstrating clipping to image boundaries b.CircleRgb(300, 249, 200, 0xff2020) // red if err := b.WritePpmFile("circle.ppm"); err != nil { fmt.Println(err) }
}</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>
Java
<lang java> import java.awt.Color;
public class MidPointCircle { private BasicBitmapStorage image;
public MidPointCircle(final int imageWidth, final int imageHeight) { this.image = new BasicBitmapStorage(imageWidth, imageHeight); }
private void drawCircle(final int centerX, final int centerY, final int radius) { int d = (5 - r * 4)/4; int x = 0; int y = radius; Color circleColor = Color.white;
do { image.setPixel(centerX + x, centerY + y, circleColor); image.setPixel(centerX + x, centerY - y, circleColor); image.setPixel(centerX - x, centerY + y, circleColor); image.setPixel(centerX - x, centerY - y, circleColor); image.setPixel(centerX + y, centerY + x, circleColor); image.setPixel(centerX + y, centerY - x, circleColor); image.setPixel(centerX - y, centerY + x, circleColor); image.setPixel(centerX - y, centerY - x, circleColor); if (d < 0) { d += 2 * x + 1; } else { d += 2 * (x - y) + 1; y--; } x++; } while (x <= y);
} } </lang>
Mathematica
<lang mathematica>SetAttributes[drawcircle, HoldFirst]; drawcircle[img_, {x0_, y0_}, r_, color_: White] :=
Module[{f = 1 - r, ddfx = 1, ddfy = -2 r, x = 0, y = r, pixels = {{0, r}, {0, -r}, {r, 0}, {-r, 0}}}, While[x < y, If[f >= 0, y--; ddfy += 2; f += ddfy]; x++; ddfx += 2; f += ddfx; pixels = Join[pixels, {{x, y}, {x, -y}, {-x, y}, {-x, -y}, {y, x}, {y, -x}, {-y, x}, {-y, -x}}]]; img = ReplacePixelValue[img, {x0, y0} + # -> color & /@ pixels]]</lang>
Example usage(it will draw a circle on Lena's face.): <lang mathematica>img = ExampleData[{"TestImage", "Lena"}]; drawcircle[img, {250, 250}, 100]</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>
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>
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>
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>
Racket
Port of the Pyhton solution.
<lang racket>
- lang racket
(require racket/draw)
(define-syntax ⊕ (syntax-rules () [(_ id e) (set! id (+ id e))]))
(define (draw-point dc x y)
(send dc draw-point x y))
(define (draw-circle dc x0 y0 r)
(define f (- 1 r)) (define ddf_x 1) (define ddf_y (* -2 r)) (define x 0) (define y r) (draw-point dc x0 (+ y0 r)) (draw-point dc x0 (- y0 r)) (draw-point dc (+ x0 r) y0) (draw-point dc (- x0 r) y0) (let loop () (when (< x y) (when (>= f 0) (⊕ y -1) (⊕ ddf_y 2) (⊕ f ddf_y)) (⊕ x 1) (⊕ ddf_x 2) (⊕ f ddf_x) (draw-point dc (+ x0 x) (+ y0 y)) (draw-point dc (- x0 x) (+ y0 y)) (draw-point dc (+ x0 x) (- y0 y)) (draw-point dc (- x0 x) (- y0 y)) (draw-point dc (+ x0 y) (+ y0 x)) (draw-point dc (- x0 y) (+ y0 x)) (draw-point dc (+ x0 y) (- y0 x)) (draw-point dc (- x0 y) (- y0 x)) (loop))))
(define bm (make-object bitmap% 25 25)) (define dc (new bitmap-dc% [bitmap bm])) (send dc set-smoothing 'unsmoothed) (send dc set-pen "red" 1 'solid) (draw-circle dc 12 12 12) bm </lang>
REXX
(Because of character output, a circle appears to be elongated in the vertical direction because characters are "taller" than they're "wide". <lang rexx>/*REXX pgm plots 3 circles using midpoint/Bresenham's circle algorithm. */
EoE = 200 /*EOE = End Of Earth, er, plot. */
image. = 'fa'x /*fill the array with middle-dots*/ pChar = '*'
do j=-EoE to +EoE /*draw grid from lowest──>highest*/ image.j.0 = '─' /*draw the horizontal axis. */ image.0.j = '│' /* " " verical " */ end /*j*/
image.0.0='┼' /*"draw" the axis origin. */ minX=0; maxX=0 minY=0; maxY=0 call draw_circle 0, 0, 8, '#' call draw_circle 0, 0, 11, '$' call draw_circle 0, 0, 19, '@' border=2 minX=minX-border*2; maxX=maxX+border*2 minY=minY-border ; maxY=maxY+border
do y=maxY by -1 to minY; aRow= do x=minX to maxX aRow=aRow || image.x.y end /*x*/ say aRow end /*y*/
exit /*stick a fork in it, we're done.*/ /*───────────────────────────────────DRAW_CIRCLE subroutine─────────────*/ draw_circle: procedure expose image. minX maxX minY maxY parse arg xx, yy, r, point; f=1-r; ddfx=1; ddfy=-2*r; y=r _=yy+r; image.xx._='*' _=xx+r; image._.yy='*' _=yy-r; image.xx._='*' _=xx-r; image._.yy='*'
do x=0 while x<y if f>=0 then do; y=y-1; ddfy=ddfy+2; f=f+ddfy; end ddfx=ddfx+2; f=f+ddfx x_=xx+x; y_=yy+y; call plotXY x_, y_, point x_=xx+y; y_=yy+x; call plotXY x_, y_, point x_=xx+y; y_=yy-x; call plotXY x_, y_, point x_=xx+x; y_=yy-y; call plotXY x_, y_, point x_=xx-x; y_=yy-y; call plotXY x_, y_, point x_=xx-y; y_=yy-x; call plotXY x_, y_, point x_=xx-y; y_=yy+x; call plotXY x_, y_, point x_=xx-x; y_=yy+y; call plotXY x_, y_, point end /*x*/
return /*──────────────────────────────────PLOTXY subroutine───────────────────*/ plotXY: procedure expose image. minX maxX minY maxY; parse arg xx, yy, p image.xx.yy=p; minX=min(minX,xx); maxX=max(maxX,xx)
minY=min(minY,yy); maxY=max(maxY,yy)
return</lang> output
························│························ ························│························ ························│························ ························│························ ························│························ ·····················@@@@@@@····················· ··················@@@···│···@@@·················· ················@@······│······@@················ ···············@········│········@··············· ·············@@·········│·········@@············· ············@···········│···········@············ ···········@············│············@··········· ··········@·············│·············@·········· ·········@············$$$$$············@········· ·········@··········$$··│··$$··········@········· ········@··········$····│····$··········@········ ·······@·········$$····###····$$·········@······· ·······@········$····##·│·##····$········@······· ······@·········$···#···│···#···$·········@······ ······@········$···#····│····#···$········@······ ······@·······$···#·····│·····#···$·······@······ ·····@········$··#······│······#··$········@····· ·····@·······$···#······│······#···$·······@····· ·····@·······$··#·······│·······#··$·······@····· ─────@───────$──#───────┼───────#──$───────@───── ·····@·······$··#·······│·······#··$·······@····· ·····@·······$···#······│······#···$·······@····· ·····@········$··#······│······#··$········@····· ······@·······$···#·····│·····#···$·······@······ ······@········$···#····│····#···$········@······ ······@·········$···#···│···#···$·········@······ ·······@········$····##·│·##····$········@······· ·······@·········$$····###····$$·········@······· ········@··········$····│····$··········@········ ·········@··········$$··│··$$··········@········· ·········@············$$$$$············@········· ··········@·············│·············@·········· ···········@············│············@··········· ············@···········│···········@············ ·············@@·········│·········@@············· ···············@········│········@··············· ················@@······│······@@················ ··················@@@···│···@@@·················· ·····················@@@@@@@····················· ························│························ ························│························ ························│························ ························│························ ························│························
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>
Scala
Uses the Scala Basic Bitmap Storage class. <lang scala>object BitmapOps {
def midpoint(bm:RgbBitmap, x0:Int, y0:Int, radius:Int, c:Color)={ var f=1-radius var ddF_x=1 var ddF_y= -2*radius var x=0 var y=radius
bm.setPixel(x0, y0+radius, c) bm.setPixel(x0, y0-radius, c) bm.setPixel(x0+radius, y0, c) bm.setPixel(x0-radius, y0, c)
while(x < y) { if(f >= 0) { y-=1 ddF_y+=2 f+=ddF_y } x+=1 ddF_x+=2 f+=ddF_x
bm.setPixel(x0+x, y0+y, c) bm.setPixel(x0-x, y0+y, c) bm.setPixel(x0+x, y0-y, c) bm.setPixel(x0-x, y0-y, c) bm.setPixel(x0+y, y0+x, c) bm.setPixel(x0-y, y0+x, c) bm.setPixel(x0+y, y0-x, c) bm.setPixel(x0-y, y0-x, c) } }
}</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>
XPL0
<lang XPL0>include c:\cxpl\codes; \include 'code' declarations
proc Circle(X0, Y0, Radius, Color); \Display a circle int X0, Y0, \coordinates of center
Radius, \radius in (pixels) Color; \line color
int X, Y, E, U, V;
proc PlotOctants; \Segment [Point(X0+Y, Y0+X, Color); \ 0 Point(X0+X, Y0+Y, Color); \ 1 Point(X0-X, Y0+Y, Color); \ 2 Point(X0-Y, Y0+X, Color); \ 3 Point(X0-Y, Y0-X, Color); \ 4 Point(X0-X, Y0-Y, Color); \ 5 Point(X0+X, Y0-Y, Color); \ 6 Point(X0+Y, Y0-X, Color); \ 7 ]; \PlotOctants
[X:= 0; Y:= Radius; U:= 1; V:= 1 -Radius -Radius; E:= 1 -Radius; while X < Y do
[PlotOctants; if E < 0 then [U:= U+2; V:= V+2; E:= E+U] else [U:= U+2; V:= V+4; E:= E+V; Y:= Y-1]; X:= X+1; ];
if X = Y then PlotOctants; ]; \Circle
[SetVid($112); \640x480 in 24-bit RGB color Circle(110, 110, 50, $FFFF00); if ChIn(1) then []; \wait for keystroke SetVid(3); \restore normal text mode ]</lang>
zkl
Image cribbed from the BBC BASIC entry. Algorithm from Wikipedia article.
<lang zkl>class PPM{
fcn init(width,height,rgb=0){ sz:=width*height; var [const] data=sz.pump(Data(sz*3),T(Void,rgb.toBigEndian(3))), // initialize to Black (RGB=000)
w=width, h=height;
} fcn fill(rgb){ sz:=data.len()/3; data.clear(); sz.pump(data,T(Void,rgb.toBigEndian(3))); } fcn __sGet(x,y){ data.toBigEndian(y*w*3 + x,3); } //ppm[x,y] fcn __sSet(rbg,x,y){ data[y*w*3 + x*3,3]=rbg.toBigEndian(3); } //ppm[x,y]=rgb fcn write(out){ out.write("P6\n#rosettacode PPM\n%d %d\n255\n".fmt(w,h)); out.write(data); } fcn circle(x0,y0,r,rgb){ x:=r; y:=0; radiusError:=1-x; while(x >= y){ __sSet(rgb, x + x0, y + y0);
__sSet(rgb, y + x0, x + y0); __sSet(rgb,-x + x0, y + y0); __sSet(rgb,-y + x0, x + y0); self[-x + x0, -y + y0]=rgb; // or do it this way, __sSet gets called as above self[-y + x0, -x + y0]=rgb; self[ x + x0, -y + y0]=rgb; self[ y + x0, -x + y0]=rgb; y+=1; if (radiusError<0) radiusError+=2*y + 1; else{ x-=1; radiusError+=2*(y - x + 1); }
} }
}</lang> <lang zkl>ppm:=PPM(200,200,0xFF|FF|FF); ppm.circle(100,100,40,00); // black circle ppm.circle(100,100,80,0xFF|00|00); // red circle
ppm.write(File("foo.ppm","wb"));</lang>