Author Topic: Amazing New Circle Drawing Algorithms  (Read 2166 times)

B+

• Full Member
• Posts: 215
Amazing New Circle Drawing Algorithms
« on: May 16, 2015 »
Here is Ying Yang demo of faster drawing circles and disks!

Move mouse up (slowly) to speed up swirl, move down screen (slowly) to slow down, esc to quit:
Code: [Select]
`rem ying yang.txt for Naalaa 2015-05-15 MGA/B+rem translated from SmallBasic started 2015-05-14 MGA/B+rem Now with new and vastly improved circle drawing algorithms 2015-05-15rem so this demo works even better in Naalaa.rem This is hugely improved algorithm!procedure circ(x,y,r) rsq=r*r;ly=0 for cx=r downto 0 cy=int(sqr#(float(rsq-cx*cx))) for dy=ly to cy draw pixel x+cx,y+dy;draw pixel x+cx,y-dy;draw pixel x-cx,y-dy;draw pixel x-cx,y+dy next ly=cy nextendprocrem This is not too shabby either!procedure disk(x,y,r) rsq=r*r;ly=0 for cx=r downto 0 cy=int(sqr#(float(rsq-cx*cx))) for dy=ly to cy draw pixel x+cx,y+dy;draw pixel x+cx,y-dy;draw pixel x-cx,y-dy;draw pixel x-cx,y+dy next nextendprocrem here is actual Ying Yang to show off new algorithmsprocedure YY(xc,yc,rc)        fr#=float#(rc) x1=xc+int(fr#*sin(i#))        y1=yc+int(fr#*cos(i#)) set color 255,255,255        _disk x1,y1,rc set color 0,0,0       _disk x1,y1,rc/3       x2=xc+int(fr#*sin(i#+180.0))       y2=yc+int(fr#*cos(i#+180.0))       _disk x2,y2,rc       set color 255,255,255       _disk x2,y2,rc/3-2endprocrem =========================mainset window 0,0,700,700set redraw offsq=700set color 96,0,0draw rect 0,0,sq,sq,truevisible:i#=0.0hidden:a#=5.0;lf=255while keydown(27)=0 _YY sq/2,sq/2,sq/8 set color 96,0,0 if a#<8.0 trim=1 elseif a#<14.0 trim=2 elseif a#<18.0 trim=3 elseif a#<20.0 trim=4 elseif a#<25.0 trim=5 else trim=6 endif for t=1 to trim _circ sq/2,sq/2,sq/4-t next redraw i#=i#+a#;if i#>360.0 then i#=i#-360.0 f=mousey() if f>lf a#=a#-0.25 if a#<0.5 then a#=0.5 lf=f elseif f<lf a#=a#+0.25 if a#>30.0 then a#=30.0 lf=f endifwend`
B+

B+

• Full Member
• Posts: 215
Re: Amazing New Circle Drawing Algorithms
« Reply #1 on: May 18, 2015 »
BTW here is the code from the tests:

Best circle algorithm I found on this forum in searches. "Best" by my criteria of drawing a ball without leaving holes:
Code: [Select]
`rem Circle test v1 revised 2015-04-21 B+rem here we test idea that you only have to tell the compiler once your variable is a floatrem modified circle procedure so color can be set by caller program of circle procedurerem so more color this time around testing a general circle proc also .1 better! refinementrem modified 2015-05-15 shaved some time off 255 radius balls taking:972-1080 msecs from 1100-1200toc=time()sq=520 set window 0,0,sq,sqset redraw offrem originx0 = sq/2y0 = sq/2for i=0 to 255 set color 255-i,255-i,255-i _circle x0,y0,inexttic=time()set color 255,255,255wln "This took ",tic-toc," msecs to draw." redrawwait keydownendprocedure circle(x,y,r) q#=0.0;fr#=float(r) do xp=int(sin(q)*fr) yp=int(cos(q)*fr) draw pixel xp+x,yp+y;q=q+0.1 until q>=360.0endproc`
And here is the code and times for algorithm I came up with to draw a ball without holes:
Code: [Select]
`rem circle algorithm2 test.txt for Naalaa 2015-05-15 B+rem Success!! completely full 255 ball in: 144-206 msecsrem takes as long to draw a filled circle as it does a circle procedure circ(x,y,r) rsq=r*r;ly=0 for cx=r downto 0 cy=int(sqr#(float(rsq-cx*cx))) for dy=ly to cy draw pixel x+cx,y+dy;draw pixel x+cx,y-dy;draw pixel x-cx,y-dy;draw pixel x-cx,y+dy next ly=cy nextendprocprocedure disk(x,y,r) rsq=r*r;ly=0 for cx=r downto 0 cy=int(sqr#(float(rsq-cx*cx))) for dy=ly to cy draw pixel x+cx,y+dy;draw pixel x+cx,y-dy;draw pixel x-cx,y-dy;draw pixel x-cx,y+dy next nextendproctoc=time()sq=520 set window 0,0,sq,sqset redraw offrem originx0 = int(sq/2)y0 = int(sq/2)for i=0 to 255 rem set color 255-i,255-i,255-i set color i,i,i _circ x0,y0,inext tic=time()set color 255,255,255wln "This took ",tic-toc," msecs to draw."  redrawwait keydown`
If anyone knows of a faster algorithm, I'd be interested in seeing it.

B+
« Last Edit: May 18, 2015 by B+ »
B+

Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
Re: Amazing New Circle Drawing Algorithms
« Reply #2 on: May 19, 2015 »
Nice puzzle. I spent hours trying to beat that algorithm... No way.
That did lead to another algorithm; A circle command for solid circles.

Code: [Select]
` toc=time()set window 0,0,800,600set redraw off set color 0,0,255   proc circle 260,260,255tic=time()set color 255,255,255wln "This took ",tic-toc," msecs to draw."  redrawwait keydownendprocedure circle(x,y,r)      b# ; a = 0      y2 = y +200      for a = 0 to r          b = sqr(float( (r*r)-(a*a) ) )          x2 = x + a          x3 = x - a          y2 = y + int(b)          draw line x3, y-int(b) ,x3,y2          draw line x2, y-int(b) ,x2,y2      nextendproc `

B+

• Full Member
• Posts: 215
Circle fill algorithms
« Reply #3 on: May 20, 2015 »
Hi Rick,

Yep! Quite possible, drawing lines instead of every pixel might draw a filled circle faster!

y2= y+ 200

can't be right for any x,y,r circle to draw. I will check.

B+

EDIT: Ha! a joke, a red herring for those not paying close attention! You (Rick) never use that value of y2 for anything (so your circle fill is even that much faster if you remove it.)

Yes indeed! using lines to fill the circle is way, way, way faster. Good one Rick! I can't wait to try your fill circle routine in Ying Yang.

A+ from

B+

EDIT 2: BTW I will call your Rick's algorithm: rickdisk(x,y,r)

« Last Edit: May 20, 2015 by B+ »
B+

B+

• Full Member
• Posts: 215
Re: Amazing New Circle Drawing Algorithms
« Reply #4 on: May 20, 2015 »
Rick!

We aren't in Kansas anymore. Check out this latest version of Ying Yang with the new circle fill algorithm and modified mouse accelerator.

I thought the sdlBasic version could not be beat but thanks to you this:
Code: [Select]
`rem ying yang2.txt for Naalaa 2015-05-19 MGA/B+rem translated from SmallBasic started 2015-05-14 MGA/B+rem now with new and vastly improved circle drawing algorithms 2015-05-15rem now with a vastly improved circle fill drawing algorithm, thanks Rickrem move mouse slowly up or down screen to adjust speed of swirl, esc to quitrem This is hugely improved algorithm! 2015-05-15procedure circ(x,y,r) rsq=r*r;ly=0 for cx=r downto 0 cy=int(sqr#(float(rsq-cx*cx))) for dy=ly to cy draw pixel x+cx,y+dy;draw pixel x+cx,y-dy;draw pixel x-cx,y-dy;draw pixel x-cx,y+dy next ly=cy nextendprocrem 2015-05-19 modified circle fill algorithm thanks to Rick, modified more by meprocedure disk(x,y,r)      for a = 0 to r          b = int(sqr(float(r*r-a*a)))   x1=x+a;x2=x-a;y1=y-b;y2=y+b          draw line x1,y1,x1,y2          draw line x2,y1,x2,y2      nextendprocrem here is actual Ying Yang to show off new algorthmsprocedure YY(xc,yc,rc) fr#=float#(rc) x1=xc+int(fr#*sin(i#))        y1=yc+int(fr#*cos(i#)) set color 255,255,255        _disk x1,y1,rc set color 0,0,0        _disk x1,y1,rc/3        x2=xc+int(fr#*sin(i#+180.0))        y2=yc+int(fr#*cos(i#+180.0))        _disk x2,y2,rc set color 255,255,255        _disk x2,y2,rc/3-2endprocrem =========================mainset window 0,0,700,700set redraw offsq=700set color 0,0,255draw rect 0,0,sq,sq,truevisible:i#=0.0hidden:a#=5.0;lf=255while keydown(27)=0 _YY sq/2,sq/2,sq/8 set color 0,0,255 if a#<8.0 trim=1 elseif a#<14.0 trim=2 elseif a#<18.0 trim=3 elseif a#<20.0 trim=4 elseif a#<25.0 trim=5 else trim=6 endif for t=1 to trim _circ sq/2,sq/2,sq/4-t next redraw i#=i#+a#;if i#>360.0 then i#=i#-360.0 f=mousey() a#=float(f*360/700)wend`
« Last Edit: May 20, 2015 by B+ »
B+

Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
Re: Amazing New Circle Drawing Algorithms
« Reply #5 on: May 20, 2015 »
Awesome demo! Runs at warp 10

B+

• Full Member
• Posts: 215
Re: Amazing New Circle Drawing Algorithms
« Reply #6 on: May 21, 2015 »
Ah, a few more msecs shaved off circle fill by not recalculating r*r over and over:

Code: [Select]
`procedure rmDisk(x,y,r)      rsq=r*r      for a = 0 to r          b = int(sqr(float(rsq-a*a)))          x1=x+a;x2=x-a;y1=y-b;y2=y+b          draw line x1,y1,x1,y2          draw line x2,y1,x2,y2      next endproc`
B+
B+

B+

• Full Member
• Posts: 215
Re: Amazing New Circle Drawing Algorithms
« Reply #7 on: May 21, 2015 »
Circle draw time cut (again) almost in half!
Using a variation of Rick's trick to draw lines instead of pixels. This probably works better with large circles.

Here is code and test results for both circle draw and circle fill draw algorithms:
Code: [Select]
`rem Circle algorithms update.txt for naalaa 2015-05-21 B+rem ============= Circle drawn 255 Ballrem my circ draws a 255 circle in 1 sec or sorem 2015-05-15       circ times (255 ball): 144 - 206 msecsrem 2015-05-21 mod  circ2 times (255 ball):  77 -  93 msecsrem ============= Circle Fill 255 Ballrem test Rick's disk drawn with lines circle filled in 4-5 msecs !!!!rem 2015-05-19     RickDisk times (255 ball):315 - 347 msecsrem 2015-05-20 mod   rmDisk times (255 ball):313 - 352 msecsrem 2015-05-21 mod2  rmDisk times (255 ball):293 - 345 msecsrem 2015-05-21 modprocedure rmDisk(x,y,r)      rsq=r*r      for a = 0 to r          b = int(sqr(float(rsq-a*a)))   x1=x+a;x2=x-a;y1=y-b;y2=y+b          draw line x1,y1,x1,y2          draw line x2,y1,x2,y2      nextendprocrem 2015-05-21 new mod based on Rick's happy results draw circle faster now too!procedure circ2(x,y,r) rsq=r*r;ly=0 for cx=0 to r cy=int(sqr#(float(rsq-cx*cx))) x1=x+cx;x2=x-cx;y1=y+ly;y2=y+cy;y3=y-ly;y4=y-cy draw line x1,y1,x1,y2 draw line x1,y3,x1,y4                draw line x2,y1,x2,y2                draw line x2,y3,x2,y4 ly=cy nextendprocrem ============================================  test areasq=520 set window 0,0,sq,sqset redraw offtoc=time()rem originx0 = int(sq/2)y0 = int(sq/2)rem circle fills need to go down from 255rem and going black center to white outer edge shows holes better on black backgroundfor i=255 downto 0 set color 255-i,255-i,255-irem _circ2 x0,y0,i_rmDisk x0,y0,inexttic=time()set color 255,255,255wln "This took ",tic-toc," msecs to draw."  redrawwait keydown`
« Last Edit: May 21, 2015 by B+ »
B+

B+

• Full Member
• Posts: 215
Re: Amazing New Circle Drawing Algorithms
« Reply #8 on: May 21, 2015 »
New Puzzle:

I just found an odd thing about drawing balls with 255 radius and changing color at each iteration.

When I go down from 255 to 0 drawing circles with newest algorithm no problem, nice neat ball is drawn.

When I go 0 to 255, problem! a vertical line is left right through the center of the circle. Yikes! That's not a good thing.

What the heck??

B+
B+

B+

• Full Member
• Posts: 215
Re: Amazing New Circle Drawing Algorithms
« Reply #9 on: May 21, 2015 »
Well the remedy for the flukey thing is simple, reverse cx, start at r and go downto 0:

Code: [Select]
`procedure circ2(x,y,r) rsq=r*r;ly=0 for cx=r downto 0  cy=int(sqr#(float(rsq-cx*cx))) x1=x+cx;x2=x-cx;y1=y+ly;y2=y+cy;y3=y-ly;y4=y-cy draw line x1,y1,x1,y2 draw line x1,y3,x1,y4                draw line x2,y1,x2,y2                draw line x2,y3,x2,y4 ly=cy nextendproc`
And all is well until someone discovers another thing,

B+

EDIT: BTW when retesting the times with downto, I got a msec better on the shortest time but I got several up to 10 msecs longer on the longer side, so using downto seems to have more variable results in speed.
« Last Edit: May 21, 2015 by B+ »
B+

B+

• Full Member
• Posts: 215
Re: Amazing New Circle Drawing Algorithms
« Reply #10 on: August 28, 2016 »
Continuing my quest for the perfect circle, I add Mopz methods to the experiment.

Here are my results, yours will likely be better.

Code: [Select]
`' circ2 test.txt [B+=MGA] 2016-08-28' draw circle ' lines at 79-83 ms, still better in my opinion' pixels by mopz at 79-90 ms and very full of holes (if you want to draw rings)'draw circle filled test'2015-05-25 rmDisk 4-6 ms'2016-08-28 circByRect 5-7 ms'2016-08-28 mopz 1-3 ms   most excellent!xmax = 800 ; ymax = 600set window 200, 40, xmax, ymaxset redraw 0t = time()'  filled circle tests'set color 0, 0, 255'_rmDisk xmax/2, ymax/2, 255'_circByRect xmax/2, ymax/2, 255'_DrawFilledCircle xmax/2, ymax/2, 255'!!! clear winner DrawFilledCircle '  circle testsfor i = 255 downto 0 set color 0, 0, i '_circByLine xmax/2, ymax/2, i _DrawCircle xmax/2, ymax/2, inextset colori 0xffffffwln time() - t, " ms"redrawwait keydownprocedure circByLine(x, y, r) 'may 25, 2015 rsq = r * r; ly = 0 for cx = r downto 0 cy = int(sqr#(float(rsq - cx * cx))) x1 = x + cx; x2 = x - cx; y1 = y + ly; y2 = y+cy; y3 = y - ly; y4 = y - cy draw line x1, y1, x1, y2 draw line x1, y3, x1, y4 draw line x2, y1, x2, y2 draw line x2, y3, x2, y4 ly = cy nextendprocrem 2015-05-21 modprocedure rmDisk(x, y, r) rsq = r * r for a = 0 to r b = int(sqr(float(rsq - a * a))) x1 = x + a; x2 = x - a; y1 = y - b; y2 = y + b draw line x1, y1, x1, y2 draw line x2, y1, x2, y2 nextendproc'2016-08-28 rectangle method sure looks like allot less calcsprocedure circByRect(x, y, r) rsq = r * r for cx = r downto 0 cy = int(sqr#(float#(rsq - cx * cx))) draw rect x - cx, y - cy, 2 * cx, 2 * cy nextendprocprocedure DrawCircle(x0, y0, radius) 'by mopz, oh by pixels x = radius y = 0 err = 0 while x >= y draw pixel x0 + x, y0 + y draw pixel x0 - x, y0 + y draw pixel x0 + y, y0 + x draw pixel x0 - y, y0 + x draw pixel x0 - x, y0 - y draw pixel x0 + x, y0 - y draw pixel x0 - y, y0 - x draw pixel x0 + y, y0 - x y = y + 1 err = err + 1 + 2*y if 2*(err - x) + 1 > 0 x = x - 1 err = err + 1 - 2*x endif wendendprocprocedure DrawFilledCircle(x0, y0, radius) x = radius y = 0 err = 0 while x >= y x2 = x*2; y2 = y*2 draw rect x0 - x, y0 + y, x2, 1, true draw rect x0 - y, y0 + x, y2, 1, true draw rect x0 - x, y0 - y, x2, 1, true draw rect x0 - y, y0 - x, y2, 1, true y = y + 1 err = err + 1 + 2*y if 2*(err - x) + 1 > 0 x = x - 1 err = err + 1 - 2*x endif wendendproc`
B+

Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
Re: Amazing New Circle Drawing Algorithms
« Reply #11 on: May 23, 2017 »
Here is my latest Circle Drawing Algorithm:

p1[72]
p# = 0.0
xp = 0 ; yp = 1
for cnt = 0 to 35
p# = float#(cnt)
p1[xp] = x + int(cos(p * 10.0) * float#(radius))
p1[yp] = y + int(sin(p * 10.0) * float#(radius))
xp = xp + 2 ; yp = yp + 2
next

set color 0, 0, 250
draw poly p1, true

endproc

Marcus

• Hero Member
• Posts: 552
Re: Amazing New Circle Drawing Algorithms
« Reply #12 on: May 24, 2017 »
Maybe I should just add a "draw circle" to the language to end this madness
.\\\opz

Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
Re: Amazing New Circle Drawing Algorithms
« Reply #13 on: May 24, 2017 »

To quote an old poet; (Shakespeare) " There's method to his madness "