fill circle with scan lines

[BasicCoder2]

https://en.wikipedia.org/wiki/Midpoint_circle_algorithm

Code: Select all

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls  'black ink, white paper


sub drawcircle(x0 as integer,y0 as integer, radius as integer,c as ulong,fill as integer)

    dim as integer x = radius
    dim as integer y = 0
    dim as integer err1 = 0

    while x >= y
        
        if fill = 1 then
            line (x0 - y, y0 - x)-(x0 + y, y0 - x),c
            line (x0 - x, y0 - y)-(x0 + x, y0 - y),c
            line (x0 - x, y0 + y)-(x0 + x, y0 + y),c
            line (x0 - y, y0 + x)-(x0 + y, y0 + x),c
        else

            pset(x0 + x, y0 + y),c
            pset(x0 + y, y0 + x),c
            pset(x0 - y, y0 + x),c
            pset(x0 - x, y0 + y),c
            pset(x0 - x, y0 - y),c
            pset(x0 - y, y0 - x),c
            pset(x0 + y, y0 - x),c
            pset(x0 + x, y0 - y),c
            
        end if
        
        
        y = y + 1
        err1 = err1 + 1 + 2*y
        if 2*(err1-x) + 1 > 0 then
            x = x - 1
            err1 = err1 + 1 - 2*x
        end if

    wend
end sub

'draw circle(x,y,radius,color,fill)               
drawCircle(320,240,100,rgb(255,255,0),1)     'draw yellow disc
drawCircle(320,240,100,rgb(0,  0,  0),0)     'draw black border

sleep

[MrSwiss]

Interesting Article but, there is a much simpler way (in FB):

Code: Select all

Circle (320, 240), 100, RGB(255,255,  0),,,, F
Circle (320, 240), 100, RGB(  0,  0,  0)

sleep

[BasicCoder2]

@MrSwiss,
:)
It was the result of a misunderstanding of Tourist Trap's requirements and a statement by Stonemonkey.
"This is not an efficient way to fill a circle, pixels, particularly near the middle will be rewritten many times, far better to do it as scanlines"
I searched for a post on a Bresenham based fill circle with scan lines example and found one by rdc,
http://www.freebasic.net/forum/viewtopi ... +bresenham
And on going to the site decided to translate the C code example myself. Perhaps I should have kept it to myself.
Of course you would normally use the fb circle command which I suspect doesn't use sin/cos to generate?
Often however FreeBasic doesn't have what you need and thus you may go back to the mechanics behind how these things are drawn. For example the line command does not have a pen size and it is simpler to write your own rather than use a tricky work around with line's one pixel width.

Another example with the fb circle (ovals) command I once wanted to rotate the oval and there is no parameter for doing that with the current circle command so I had to write one myself see below.

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

dim shared as double dx,dy
dim shared as double cx,cy  'center of oval
dim shared as double x1,y1,x2,y2
dim shared as double ww
dim shared as uinteger cc
ww = 45

cx = 320
cy = 240
screenres 640,480,32
for ww = 0 to 180*DtoR step 10*DtoR
    cc = rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256))
    for angle as double = 0 to 359*DtoR step 1*DtoR
        dx = Cos(angle)
        dy = Sin(angle)
        x1 = dx * 50
        y1 = dy * 100
        ' rotate around cx,cy
        x2 = Cos(ww) * x1 - Sin(ww) * y1
        y2 = Cos(ww) * y1 + Sin(ww) * x1    
        pset (x2+100,y2+100),cc
    next angle
    sleep
next ww

[MrSwiss]

@BasicCoder2,

it's just funny to notice, that sometimes, independently, we seem to work at similar tasks/solutions for
similar problems, in programming ...

Perhaps I should have kept it to myself.

No, I don't think so, it is interesting to see such things, even if they are for understanding the base of
the problem better.

... the fb circle command which I suspect doesn't use sin/cos to generate?

Unfortunately, I can't answer that one. counting_pine is the fbGFX specialist here (at least, he fixed it,
the last time I've found a bug: "Line" Statement 'Style' parameter, in x64 FBC).

I've just about finished a SineWave "drawing" routine, I'll post shortly ...

[Stonemonkey]

I was thinking more something like this

Code: Select all

sub filled_circle(byval cx as integer,byval cy as integer,byval r as integer,byval c as unsigned long)
    for y_off as integer=-r to r
        dim as integer dx=sqr(r*r-y_off*y_off) '-0.4999  'adjustment to match filled_circle2
        for x_off as integer=-dx to dx
            pset(cx+x_off,cy+y_off),c
        next
    next
end sub

sub filled_circle2(byval cx as integer,byval cy as integer,byval r as integer,byval c as unsigned long)
    for y_off as integer=-r to r
        for x_off as integer=-r to r
            if (x_off*x_off+y_off*y_off)<=(r*r) then pset (cx+x_off,cy+y_off),c
        next
    next
end sub

'slightly optimised version
sub filled_circle2o(byval cx as integer,byval cy as integer,byval r as integer,byval c as unsigned long)
    dim as integer r2=r*r
    for y_off as integer=-r to r
        dim as integer y=cy+y_off,r2my2=r2-y_off*y_off
        for x_off as integer=-r to r
            if (x_off*x_off)<=r2my2 then pset (cx+x_off,y),c
        next
    next
end sub

sub main
    screenres 640,480,32,2
    screenset 0,1
    
    while inkey<>chr(27)
        
        filled_circle 200,200,100,&hff00ff
        
        flip
        cls
    wend
end sub

main
end

although, ive just thrown this together I would probably look more into using floats and fill convention and writing to the screenbuffer with pointers.

[dafhi]

too fun

Code: Select all

sub filled_circle(byval cx as single=0,byval cy as single=0,byval r as single=1.5,byval c as unsigned long)
  for inty as integer = cy-r to cy+r
    var dy = inty-cy
    var dx = sqr(r*r-dy*dy)
    line ( cx-dx,cy+dy)-( cx+dx,cy+dy), c
  next
End Sub


sub main
    var w = 640, midx = w/2
    var h = 480, midy = h/2
    
    screenres w,h,32,2
    screenset 0,1
    
    var a = 0f, iangle = 8*atn(1) / 9000
    var offset = 150

    while inkey<>chr(27)
        filled_circle midx + offset*cos(a), midy+offset*sin(a), 100,&hff00ff
        a+=iangle
        flip:  sleep 1
        cls
    wend
end sub

main

[Stonemonkey]

some smooth circles

Code: Select all

sub filled_circle_aa(byval cx as integer,byval cy as integer,byval r as integer,byval c as unsigned long,byval aa as single=128.0)
    for y_off as integer=-r to r
        dim as integer dx=sqr(r*r-y_off*y_off)-0.4999  
        for x_off as integer=-dx to dx
            dim as integer d=(r-sqr(x_off*x_off+y_off*y_off))*aa
            if d>255 then
                pset (cx+x_off,cy+y_off),c
            else
                dim as unsigned long p=point(cx+x_off,cy+y_off)
                pset (cx+x_off,cy+y_off),(((((c and &hff00ff)*d)+((p and &hff00ff)*(256-d)))and &hff00ff00)or((((c and &hff00)*d)+((p and &hff00)*(256-d)))and &hff0000))shr 8
            end if
        next
    next
end sub

sub main
    screenres 640,480,32,2
    screenset 0,1
    while inkey<>chr(27)
        filled_circle_aa 200,200,100,&hff
        filled_circle_aa 300,200,70,&hff00ff
        flip
        cls
    wend
end sub

main

[Stonemonkey]

With the smoothing, can be written for sub pixel positioning, the top circle is being moved by fractions of a pixel width.

Code: Select all

sub filled_circle_aa(byval cx as integer,byval cy as integer,byval r as integer,byval c as unsigned long,byval aa as single=128.0)
    for y_off as integer=-r to r
        dim as integer dx=sqr(r*r-y_off*y_off)-0.4999  
        for x_off as integer=-dx to dx
            dim as integer d=(r-sqr(x_off*x_off+y_off*y_off))*aa
            if d>255 then
                pset (cx+x_off,cy+y_off),c
            else
                dim as unsigned long p=point(cx+x_off,cy+y_off)
                pset (cx+x_off,cy+y_off),(((((c and &hff00ff)*d)+((p and &hff00ff)*(256-d)))and &hff00ff00)or((((c and &hff00)*d)+((p and &hff00)*(256-d)))and &hff0000))shr 8
            end if
        next
    next
end sub

function floor(byval f as single)as integer
    return f-.49999
end function

function ceil(byval f as single)as integer
    return f+.49999
end function

sub filled_circle_aa_sub(byval cx as single,byval cy as single,byval r as single,byval c as unsigned long,byval aa as single=128.0)
    for y as integer=floor(cy-r) to ceil(cy+r)
        for x as integer=floor(cx-r) to ceil(cx+r)
            dim as integer d=(r-sqr((x-cx)*(x-cx)+(y-cy)*(y-cy)))*aa
            if d>0 then
                if d>255 then
                    pset (x,y),c
                else
                    dim as unsigned long p=point(x,y)
                    pset (x,y),(((((c and &hff00ff)*d)+((p and &hff00ff)*(256-d)))and &hff00ff00)or((((c and &hff00)*d)+((p and &hff00)*(256-d)))and &hff0000))shr 8
                end if
            end if
        next
    next
end sub

sub main
    screenres 640,480,32,2
    screenset 0,1
    dim as single x=200
    while inkey<>chr(27)
        x+=.1
        filled_circle_aa_sub x,150,100,&hffff
        filled_circle_aa_sub 300,150,70,&hff0000
        
        filled_circle_aa x,350,100,&hffff
        filled_circle_aa 300,350,70,&hff0000
        flip
        cls
    wend
end sub

main

[dafhi]

very nice.

[Tourist Trap]

With the smoothing, can be written for sub pixel positioning, the top circle is being moved by fractions of a pixel width.

Impressive. This is a circle.

[dafhi]

[2017 Aug 14]

Code: Select all

' ------ aadot 2017 Aug 13 - by dafhi
'
'  calculation without sqr() in 2 zones:
' 1. blit corners
' 2. dot center max brightness)
' ------------------------------------

' ---------------
type imagevars '2017 July 3 - by dafhi
  '1. quick reference for ScreenInfo & ImageInfo
  '2. encapsulate standard metrics
  '3. useful additional vars, subs
  as integer            w,h, bpp,bypp,pitch, rate
  as string             driver_name
  as any ptr            im
  as any ptr            pixels    '' same address
  as ulong ptr          p32       ''
  as single             midx,midy
  as integer            pitchBy, wm = -1, hm = -1, ub = -1, is_screen
  declare sub           screen_init(w as integer=0, h as integer=0, bpp as integer=32, npages as integer=1, flags as integer=0)
  declare sub           create(w as integer=0, h as integer=0, col as ulong=&HFF000000)
  declare sub           get_info(im as any ptr=0)
  declare               destructor
 private:
  declare sub           destroy
  declare sub           release
  as any ptr            hRelease
end type
Destructor.imagevars:  release
End Destructor
sub imagevars.release                             '2016 Aug 30
  w=0: h=0: bpp=0: bypp=0: im=0: pixels=0
  If ImageInfo(hRelease) = 0 Then ImageDestroy hRelease:  hRelease = 0
End Sub
sub imagevars.get_info(im as any ptr)
  if im=0 then
    ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name:  pixels=screenptr
    is_screen = -1: im=0
  elseif Imageinfo(im)=0 then
    ImageInfo im, w, h, bypp, pitch, pixels:  bpp = bypp * 8
    this.im = im:  is_screen = 0
  endif: hRelease = im:  p32=pixels
  wm=w-1:  midx=w/2:  pitchBy=pitch/bypp '' crashes if \ and bypp = 0
  hm=h-1:  midy=h/2:  ub = h*pitchBy - 1
end sub
sub imagevars.screen_init(w as integer, h as integer, bpp as integer, npages as integer, flags as integer)
  release '2017 July 3
  if w=0 or h=0 then get_info: w=this.w: h=this.h
  screenres w,h,bpp,npages,flags: pixels = screenptr
  get_info:  if npages > 1 then screenset 0,1
end sub
sub imagevars.create(_w as integer, _h as integer, col as ulong)
  release:  get_info imagecreate(_w,_h,col)
End Sub

#Macro Alpha256(ret,back, fore, a256) '2017 Mar 26
  ret=((_
  (fore And &Hff00ff) * a256 + _
  (back And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_
  (fore And &H00ff00) * a256 + _
  (back And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8
#EndMacro

' ---------------------
'
type dotvars
  as ulong            col=-1
  as single           rad=1,slope=1
End Type

type AaDot
  as dotvars          o
  as dotvars ptr      p
  declare sub         render_target(byref buf as imagevars)
  declare sub         draw(x as single=0, y as single=0)
  declare constructor
 private:
  as single           dy,dxLeft,salpha,cone_h,coneSq,sq
  as long             x0,y0,x1,y1,alph,alpha_max
  as imagevars ptr    pim
end type
constructor.AaDot: p=@o
end constructor
sub AaDot.render_target(byref buf as imagevars)
  pim = @buf
end sub
sub AaDot.draw(x as single, y as single)

  salpha=(p->col shr 24)/255:  alpha_max=salpha*256
  var slope = p->slope
  
  'slope = 1 .. 1 pixel aa edge
  'slope = 2 .. 1/2 pixel (sharp)
  'slope = 1/p->rad .. max blur
  'slope < 1/p->rad .. rendering artifact
  
  sq=1/p->rad                   '' clamp prevents artifact
  slope=iif(slope<sq,sq,slope)  ''
  
  cone_h=slope*p->rad     'pre-inverted aadot imagined as side-viewed cone \/
  coneSq=cone_h*cone_h    'avoid sqr() at blit corners
  sq=(cone_h-1)*(cone_h-1)'avoid sqr() in dot center at max brightness
  
  dim as long x0=x-p->rad:  if x0<0 then x0=0
  dim as long y0=y-p->rad:  if y0<0 then y0=0
  dim as long x1=x+p->rad:  if x1>pim->wm then x1=pim->wm
  dim as long y1=y+p->rad:  if y1>pim->hm then y1=pim->hm
  dy=(y0-y)*slope: dxLeft=(x0-x)*slope
  
  for py as long ptr = @pim->p32[ y0*pim->pitchBy ] to @pim->p32[ y1*pim->pitchBy ] step pim->pitchBy
    dim as single dx=dxleft, dySq=dy*dy
    for px as ulong ptr = @py[x0] to @py[x1]
      salpha = dx*dx+dySq
      if salpha<sq then
          Alpha256(*px,*px,p->col,alpha_max)
      elseif salpha<=coneSq then
          alph=(cone_h-sqr(salpha))*alpha_max
          Alpha256(*px,*px,p->col,alph)
      endif:  dx+=slope
    next: dy+=slope
  next
end sub


sub Main

  dim as imagevars    buf
  dim as aadot        dot:  dot.render_target buf
 
  const GFX_FLAG_BORDERLESS = 8

  buf.get_info:  var scalar = 1 / 1.5
  buf.screen_init buf.w*scalar, buf.h*scalar,,, GFX_FLAG_BORDERLESS '' no border
 
  var t0=timer
  do
    #define r8 int(rnd*256)
    for i as long = 1 to 2
      dot.o.col = rgba(r8,r8,r8,r8)
      dot.o.rad = 2+rnd*50
      dot.o.slope = (1+5*rnd)/dot.o.rad
      dot.draw rnd*buf.w, rnd*buf.h
      screenlock
      screenunlock
    next
    sleep 1
    dim as string kstr = inkey
    if kstr = chr(27) or timer-t0 > 5 then exit do
  loop
  
  ? "demo finished.  will now exit.."
  sleep 2000
  
end sub

Main

[leopardpm]

drats, crashes on my system

[dafhi]

updated. compiling without gcc,

Code: Select all

type animvars
  ..
  as boolean            mirror = int(rnd+.5) 'crashes

[leopardpm]

both ways still crash my system...

[dafhi]

i am computing blit width based upon sqr(r*r-dy*dy), and initial dy was sometimes larger than r

fixed it:

Code: Select all

  clip_b = int(y - pcv->rad+1)
  clip_t = int(y + pcv->rad-.5)