' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2023.08.29.21.34]) on 2023.09.15 at 00:32 (Coordinated Universal Time)
' This BAM program, including the "TCIRCLE" subroutine, by Charlie Veniot
' Contributions by paul doe: "circle_Bresenham" and "circle_midpoint" FreeBASIC subroutines, ported by Charlie to BAM and tweaked for "aspect_ratio"
' "Triangle Math" important points:
' * R is the right angle
' * r is opposite side
' * r squared = x squared + y squared
' "aspect_ratio" is the height of a pixel vs the width, width always being = 1; this is a BAM requirement for compatibility with GW-BASIC screen modes
aspect_ratio = 1 ' so pixel height is 1 times pixel width for screen mode 12
' aspect_ratio = 2.4 ' so pixel height is 2.4 times pixel width for screen mode 8 in BAM and GW-BASIC
' aspect_ratio = 1.2 ' so pixel height is 1.2 times pixel width for screen mode 7 in BAM and GW-BASIC
DECLARE SUB circle_Charlie( xc as long, yc as long, r as long, c as LONG )
DECLARE SUB circle_Bresenham( xc as long, yc as long, r as long, c AS LONG )
DECLARE SUB circle_midpoint( xc as long, yc as long, r as long, c as LONG )
c_radius = 100
c1x = 10 + c_radius : c1y = 18 + c_radius ' COLOR statement
c2x = 20 + c_radius * 3 : c2y = c1y ' Charlie's TCIRCLE subroutine
c3x = 30 + c_radius * 5 : c3y = c1y ' Paul's circle_Bresenham
c4x = 40 + c_radius * 7 : c4y = c1y ' Paul's circle_midpoint
iterations = 0
cpi = 100
dim as double c1_time = 0, c2_time = 0, c3_time = 0, c4_time = 0, start_time = 0
SCREEN _NEWIMAGE(c_radius * 8 + 50, c_radius * 2 + 20, 12)
DO
CLS
start_time = timer
FOR i = 1 TO cpi : CIRCLE (c1x, c1y), c_radius, 14 : NEXT i
c1_time = c1_time + timer - start_time
start_time = timer
' FOR i = 1 TO cpi : GOSUB TCIRCLE : NEXT i
FOR i = 1 TO cpi : circle_Charlie( c2x, c2y, c_radius, 14 ) : NEXT i
c2_time = c2_time + timer - start_time
start_time = timer
FOR i = 1 TO cpi : circle_Bresenham( c3x, c3y, c_radius, 14 ) : NEXT i
c3_time = c3_time + timer - start_time
start_time = timer
FOR i = 1 TO cpi : circle_midpoint( c4x, c4y, c_radius, 14 ) : NEXT i
c4_time = c4_time + timer - start_time
iterations = iterations + cpi
LOCATE 0,0
PRINT "count: " + iterations + " circles drawn that many times for each method"
LOCATE 8, 5 : PRINT "CIRCLE time: " + INT(c1_time)
LOCATE 8, 31 : PRINT "Charlie's time: " + INT(c2_time)
LOCATE 8, 57 : PRINT "Bresenham time: " + INT(c3_time)
LOCATE 8, 83 : PRINT "Midpoint time: " + INT(c4_time)
_display
LOOP
END
TCIRCLE: ' This GOSUB subroutine replaced by a SUB, for apples to apples performance comparison with the other subroutines.
FOR xy = 0 TO c_radius*0.75
a = SQR( c_radius * c_radius - xy * xy )
a_ar = a/aspect_ratio
xy_ar = xy/aspect_ratio
PSET (c2x + xy, c2y - a_ar), 14
PSET (c2x - xy, c2y - a_ar), 14
PSET (c2x + xy, c2y + a_ar), 14
PSET (c2x - xy, c2y + a_ar), 14
PSET (c2x - a, c2y + xy_ar), 14
PSET (c2x - a, c2y - xy_ar), 14
PSET (c2x + a, c2y + xy_ar), 14
PSET (c2x + a, c2y - xy_ar), 14
NEXT xy
RETURN
sub circle_Charlie( xc as long, yc as long, r as long, c as LONG )
DIM as long xy, a, a_ar, xy_ar
FOR xy = 0 TO r*0.75
a = SQR( r * r - xy * xy )
a_ar = a/aspect_ratio
xy_ar = xy/aspect_ratio
PSET (xc + xy, yc - a_ar), 14
PSET (xc - xy, yc - a_ar), 14
PSET (xc + xy, yc + a_ar), 14
PSET (xc - xy, yc + a_ar), 14
PSET (xc - a, yc + xy_ar), 14
PSET (xc - a, yc - xy_ar), 14
PSET (xc + a, yc + xy_ar), 14
PSET (xc + a, yc - xy_ar), 14
NEXT xy
end sub
sub circle_Bresenham( xc as long, yc as long, r as long, c as LONG )
dim as long x = 0, y = r
dim as long d = 3 - 2 * r
' aspect_ratio approach 1
dim as double yar = y/aspect_ratio
dim as double xar = x/aspect_ratio
' aspect_ratio approach 2 (no improvement over approach 1)
' dim as double iAr = 1 / aspect_ratio ' Reciprocal of the aspect ratio
' dim as double yar = y*iAr
' dim as double xar = x*iAr
pset( xc + x, yc + yar ), c
pset( xc - x, yc + yar ), c
pset( xc + x, yc - yar ), c
pset( xc - x, yc - yar ), c
pset( xc + y, yc + xar ), c
pset( xc - y, yc + xar ), c
pset( xc + y, yc - xar ), c
pset( xc - y, yc - xar ), c
do while( y >= x )
x += 1
if( d > 0 ) then
y -= 1
d = d + 4 * ( x - y ) + 10
else
d = d + 4 * x + 6
end if
' aspect_ratio approach 1
yar = y/aspect_ratio
xar = x/aspect_ratio
' aspect_ratio approach 2 (no improvement over approach 1)
' yar = y * iar
' xar = x * iar
pset( xc + x, yc + yar ), c
pset( xc - x, yc + yar ), c
pset( xc + x, yc - yar ), c
pset( xc - x, yc - yar ), c
pset( xc + y, yc + xar ), c
pset( xc - y, yc + xar ), c
pset( xc + y, yc - xar ), c
pset( xc - y, yc - xar ), c
loop
end sub
sub circle_midpoint( xc as long, yc as long, r as long, c as LONG )
dim as long x = r, y = 0
dim as double yar = y/aspect_ratio
dim as double xar = x/aspect_ratio
dim as byte bStayInDo = TRUE
yar = y/aspect_ratio
xar = x/aspect_ratio
pset( -x + xc, yar + yc ), c
pset( y + xc, -xar + yc ), c
if( r > 0 ) then
pset( x + xc, -yar + yc ), c
pset( y + xc, xar + yc ), c
pset( -y + xc, xar + yc ), c
end if
dim as long P = 1 - r
do while( x > y ) AND bStayInDo
y += 1
if( P <= 0 ) then
P = P + 2 * y + 1
else
x -= 1
P = P + 2 * y - 2 * x + 1
end if
yar = y/aspect_ratio
xar = x/aspect_ratio
if( x < y ) then
bStayInDo = FALSE
ELSE
pset( x + xc, yar + yc ), c
pset( -x + xc, yar + yc ), c
pset( x + xc, -yar + yc ), c
pset( -x + xc, -yar + yc ), c
if( x <> y ) then
pset( y + xc, xar + yc ), c
pset( -y + xc, xar + yc ), c
pset( y + xc, -xar + yc ), c
pset( -y + xc, -xar + yc ), c
end if
END IF
loop
end sub