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

B+

  • Full Member
  • ***
  • Posts: 215
    • View Profile
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-15
rem 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
next
endproc

rem 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
next
endproc

rem here is actual Ying Yang to show off new algorithms
procedure 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-2
endproc

rem =========================main
set window 0,0,700,700
set redraw off
sq=700
set color 96,0,0
draw rect 0,0,sq,sq,true
visible:
i#=0.0
hidden:
a#=5.0;lf=255
while 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
endif
wend

B+

B+

  • Full Member
  • ***
  • Posts: 215
    • View Profile
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 float
rem modified circle procedure so color can be set by caller program of circle procedure
rem so more color this time around testing a general circle proc also .1 better! refinement
rem modified 2015-05-15 shaved some time off 255 radius balls taking:972-1080 msecs from 1100-1200
toc=time()
sq=520
set window 0,0,sq,sq
set redraw off
rem origin
x0 = sq/2
y0 = sq/2
for i=0 to 255
set color 255-i,255-i,255-i
_circle x0,y0,i
next
tic=time()
set color 255,255,255
wln "This took ",tic-toc," msecs to draw."
redraw
wait keydown
end
procedure 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.0
endproc

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 msecs
rem 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
next
endproc

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
next
endproc

toc=time()
sq=520
set window 0,0,sq,sq
set redraw off
rem origin
x0 = 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,i
next
tic=time()
set color 255,255,255
wln "This took ",tic-toc," msecs to draw." 
redraw
wait 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: 341
  • May the Force be with You
    • View Profile
    • Rick's Programs
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,600
set redraw off

set color 0,0,255

  proc circle 260,260,255
tic=time()
set color 255,255,255
wln "This took ",tic-toc," msecs to draw." 
redraw
wait keydown
end

procedure 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
      next
endproc
 


B+

  • Full Member
  • ***
  • Posts: 215
    • View Profile
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!
But in your code procedure:

 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
    • View Profile
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-15
rem now with a vastly improved circle fill drawing algorithm, thanks Rick

rem move mouse slowly up or down screen to adjust speed of swirl, esc to quit

rem This is hugely improved algorithm! 2015-05-15
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
next
endproc

rem 2015-05-19 modified circle fill algorithm thanks to Rick, modified more by me
procedure 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
      next
endproc

rem here is actual Ying Yang to show off new algorthms
procedure 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-2
endproc

rem =========================main
set window 0,0,700,700
set redraw off
sq=700
set color 0,0,255
draw rect 0,0,sq,sq,true
visible:
i#=0.0
hidden:
a#=5.0;lf=255
while 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: 341
  • May the Force be with You
    • View Profile
    • Rick's Programs
Re: Amazing New Circle Drawing Algorithms
« Reply #5 on: May 20, 2015 »
 Awesome demo! Runs at warp 10

B+

  • Full Member
  • ***
  • Posts: 215
    • View Profile
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
    • View Profile
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 Ball
rem my circ draws a 255 circle in 1 sec or so
rem 2015-05-15       circ times (255 ball): 144 - 206 msecs
rem 2015-05-21 mod  circ2 times (255 ball):  77 -  93 msecs

rem ============= Circle Fill 255 Ball
rem test Rick's disk drawn with lines circle filled in 4-5 msecs !!!!
rem 2015-05-19     RickDisk times (255 ball):315 - 347 msecs
rem 2015-05-20 mod   rmDisk times (255 ball):313 - 352 msecs
rem 2015-05-21 mod2  rmDisk times (255 ball):293 - 345 msecs

rem 2015-05-21 mod
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

rem 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
next
endproc

rem ============================================  test area
sq=520
set window 0,0,sq,sq
set redraw off
toc=time()
rem origin
x0 = int(sq/2)
y0 = int(sq/2)
rem circle fills need to go down from 255
rem and going black center to white outer edge shows holes better on black background
for i=255 downto 0
set color 255-i,255-i,255-i
rem _circ2 x0,y0,i
_rmDisk x0,y0,i
next
tic=time()
set color 255,255,255
wln "This took ",tic-toc," msecs to draw." 
redraw
wait keydown
« Last Edit: May 21, 2015 by B+ »
B+

B+

  • Full Member
  • ***
  • Posts: 215
    • View Profile
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
    • View Profile
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
next
endproc

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
    • View Profile
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 = 600
set window 200, 40, xmax, ymax
set redraw 0
t = 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 tests
for i = 255 downto 0
set color 0, 0, i
'_circByLine xmax/2, ymax/2, i
_DrawCircle xmax/2, ymax/2, i
next
set colori 0xffffff
wln time() - t, " ms"
redraw
wait keydown


procedure 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
next
endproc

rem 2015-05-21 mod
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

'2016-08-28 rectangle method sure looks like allot less calcs
procedure 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
next
endproc

procedure 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
wend
endproc

procedure 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
wend
endproc
B+

Rick3137

  • Sr. Member
  • ****
  • Posts: 341
  • May the Force be with You
    • View Profile
    • Rick's Programs
Re: Amazing New Circle Drawing Algorithms
« Reply #11 on: May 23, 2017 »
   Here is my latest Circle Drawing Algorithm:

procedure DrawCircle(x,y,radius)
    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

  • Administrator
  • Hero Member
  • *****
  • Posts: 541
    • View Profile
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 :D
.\\\opz

Rick3137

  • Sr. Member
  • ****
  • Posts: 341
  • May the Force be with You
    • View Profile
    • Rick's Programs
Re: Amazing New Circle Drawing Algorithms
« Reply #13 on: May 24, 2017 »
 ;D ;D ;D

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