It's a curious coincidence, just these days I was trying to translate the same function (I hadn't seen this post of yours), and I encountered the same problem, the starting edge seems to be drawed only at right angle.
So I tried to make a comparison between six different ways to fill a thick line (only two ot them are rasterized using iteratively a point, the others using a straight line or a filled circle).
It seems that the line scanning algorithm is optimal for this purpose (even if the time required to compute trigonometric functions were not counted).
Code: Select all
#include "fbgfx.bi"
#Include "crt/math.bi"
Using FB
#define SCR_W 640
#define SCR_H 480
Const pi2 = Acos(-1) / 2
'translation by Pitto from
'http://members.chello.at/~easyfilter/bresenham.c
sub plotLineWidth(x0 as Long, y0 as Long, x1 as Long, y1 as Long, wd as single, _color as Ulong, pImage as FB.Image ptr)
dim as Long dx = abs(x1-x0), sx
if (x0 < x1) then
sx = 1
else
sx = -1
end if
dim as Long dy = abs(y1-y0), sy
if (y0 < y1) then
sy = 1
else
sy = -1
end if
dim as Long _err = dx-dy, e2, x2, y2 'error value e_xy
dim ed as single = dx+dy
if (ed = 0) then
ed = 1
else
ed = sqr(dx*dx+dy*dy)
end if
wd = (wd+1)/2
'pixel loop
do
pset pImage, (x0, y0), _color
e2 = _err
x2 = x0
'x step
if (2*e2 >= -dx) then
e2 += dy
y2 = y0
while (e2 < ed*wd) andalso (y1 <> y2 orelse dx > dy)
y2 += sy
e2 += dx
pset pImage, (x0, y2), _color
wend
if (x0 = x1) then exit do
e2 = _err
_err -= dy
x0 += sx
end if
'y step
if (2*e2 <= dy) then
e2 = dx-e2
while (e2 < ed*wd) andalso (x1 <> x2 orelse dx < dy)
x2 += sx
e2 += dy
pset pImage, (x2, y0), _color
wend
if (y0 = y1) then exit do
_err += dx
y0 += sy
end if
loop
end sub
'translation of a c snippet by Angad
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
'translated by Pitto, edited by Mr Swiss
'see https://www.freebasic.net/forum/viewtopic.php?f=7&t=25903
Sub fill_polygon(a() As Long, ByVal c As ULong, pImage as FB.Image ptr)
Dim As Long i, j, k, dy, dx, x, y, temp
Dim As Long xi(0 to Ubound(a, 1))
Dim As Single slope(0 to Ubound(a, 1))
'join first and last vertex
a(Ubound(a, 1), 0) = a(0, 0)
a(Ubound(a, 1), 1) = a(0, 1)
For i = 0 To Ubound(a, 1) - 1
dy = a(i+1, 1) - a(i, 1)
dx = a(i+1, 0) - a(i, 0)
If (dy = 0) Then slope(i) = 1.0
If (dx = 0) Then slope(i) = 0.0
If (dy <> 0) AndAlso (dx <> 0) Then slope(i) = dx / dy
Next i
For y = 0 to SCR_H - 1
k = 0
' using FB's short-cut operators (which C doesn't have!)
For i = 0 to Ubound(a, 1) - 1
If (a(i, 1) <= y AndAlso a(i+1, 1) > y) OrElse _
(a(i, 1) > y AndAlso a(i+1, 1) <= y) Then
xi(k) = CLng(a(i, 0) + slope(i) * (y - a(i, 1)))
k += 1
End If
Next i
For j = 0 to k - 2
'Arrange x-intersections in order
For i = 0 To k - 2
If (xi(i) > xi(i + 1)) Then
temp = xi(i)
xi(i) = xi(i + 1)
xi(i + 1) = temp
End If
Next i
Next j
'line filling
For i = 0 To k - 2 Step 2
Line pImage, (xi(i), y)-(xi(i + 1) + 1, y), c
Next i
Next y
End Sub
'Fill a triangle using bresenham lines by Pitto
'see https://cglearn.codelight.eu/pub/computer-graphics/task/bresenham-triangle
'this code is released under the terms of the
'GNU LESSER GENERAL PUBLIC LICENSE Version 3
type triangle
Declare sub set_up ( x0 as integer, y0 as integer, _
x1 as integer, y1 as integer, _
x2 as integer, y2 as integer, _
c as Ulong, _
x0_cl as integer, y0_cl as integer,_
x1_cl as integer, y1_cl as integer)
declare sub make_triangle ()
declare sub make_y_point_pairs ()
declare sub sort_points(l As Long, r As Long)
declare sub _draw (pImage as FB.Image ptr)
declare sub bresenham_line(x0 As Integer, y0 As Integer, x1 As Integer, y1 As Integer)
declare function get_perimeter_points() as integer
private:
as integer v0_x, v0_y, v1_x, v1_y, v2_x, v2_y, _
x0_clip, y0_clip, x1_clip, y1_clip
as ULong _color
redim points (0 to 0, 0 to 1) as integer
redim y_pairs (0 to 0, 0 to 2) as integer
end type
function triangle.get_perimeter_points() as integer
return Ubound(points)-1
End function
Sub triangle.set_up( x0 as integer, y0 as integer, _
x1 as integer, y1 as integer, _
x2 as integer, y2 as integer, _
c as Ulong, _
x0_cl as integer, y0_cl as integer,_
x1_cl as integer, y1_cl as integer)
this.v0_x = x0 : this.v0_y = y0
this.v1_x = x1 : this.v1_y = y1
this.v2_x = x2 : this.v2_y = y2
this.x0_clip = x0_cl : this.y0_clip = y0_cl
this.x1_clip = x1_cl : this.y1_clip = y1_cl
redim points (0 to 0, 0 to 1) as integer
redim y_pairs (0 to 0, 0 to 2) as integer
this.make_triangle()
this.sort_points(Lbound(points), Ubound(points))
this.make_y_point_pairs()
this._color = c
End sub
sub triangle._draw (pImage as FB.Image ptr)
dim i as integer
for i = Lbound(this.y_pairs) to Ubound(this.y_pairs)-1
line pImage, ( this.y_pairs(i,0),_
this.y_pairs (i,1))-_
( this.y_pairs(i,0), _
this.y_pairs (i,2)), this._color
next i
end sub
'source: https://rosettacode.org/wiki/Sorting_algorithms/Quicksort#FreeBASIC
' quick sort
'a bit modified in order to sort the first column a two dimensional array
Sub triangle.sort_points(l As Long, r As Long)
Dim As ULong size = r - l +1
If size < 2 Then Exit Sub
Dim As Long i = l, j = r
Dim As Long pivot = points(l + size \ 2, 0)
Do
While points(i,0) < pivot
i += 1
Wend
While pivot < points(j,0)
j -= 1
Wend
If i <= j Then
Swap points(i,0), points(j,0)
Swap points(i,1), points(j,1)
i += 1
j -= 1
End If
Loop Until i > j
If l < j Then this.sort_points(l, j)
If i < r Then this.sort_points(i, r)
End Sub
sub triangle.make_y_point_pairs()
dim as integer i, j, max, min, x_value, k, old_max, old_min
i = 0
k = 0
while i < Ubound(this.points)-1
x_value = this.points(i,0)
max = this.points(i,1)
min = this.points(i,1)
while this.points(i,0) = x_value andAlso i < Ubound(this.points)
if this.points(i,1) > max then max = this.points(i,1)
if this.points(i,1) < min then min = this.points(i,1)
i +=1
wend
this.y_pairs(k, 0) = x_value
this.y_pairs(k, 1) = min
this.y_pairs(k, 2) = max
redim preserve this.y_pairs(0 to Ubound(this.y_pairs)+1, 0 to 2)
k +=1
wend
end sub
Sub triangle.make_triangle ()
this.bresenham_line(this.v0_x, this.v0_y, this.v1_x, this.v1_y)
this.bresenham_line(this.v1_x, this.v1_y, this.v2_x, this.v2_y)
this.bresenham_line(this.v2_x, this.v2_y, this.v0_x, this.v0_y)
end sub
' modified source from
' http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#FreeBASIC
' Ported from the C version
Sub triangle.bresenham_line(x0 As Integer, y0 As Integer, x1 As Integer, y1 As Integer)
Dim As Integer dx = Abs(x1 - x0), dy = Abs(y1 - y0)
Dim As Integer sx = IIf(x0 < x1, 1, -1)
Dim As Integer sy = IIf(y0 < y1, 1, -1)
Dim As Integer er = IIf(dx > dy, dx, -dy) \ 2, e2
Do
'clipping
if x0 > x0_clip andAlso x0 < x1_clip AndAlso _
y0 > y0_clip andAlso y1 < y1_clip then
this.points (Ubound(this.points), 0) = x0
this.points (Ubound(this.points), 1) = y0
redim preserve this.points(0 to Ubound(this.points)+1, 0 to 1)
end if
If (x0 = x1) And (y0 = y1) Then Exit Do
e2 = er
If e2 > -dx Then Er -= dy : x0 += sx
If e2 < dy Then Er += dx : y0 += sy
Loop
End Sub
''----
type quad
Declare sub set_up ( x0 as integer, y0 as integer, _
x1 as integer, y1 as integer, _
x2 as integer, y2 as integer, _
x3 as integer, y3 as integer, _
c as Ulong, _
x0_cl as integer, y0_cl as integer,_
x1_cl as integer, y1_cl as integer)
declare sub make_quad ()
declare sub make_y_point_pairs ()
declare sub sort_points(l As Long, r As Long)
declare sub _draw (pImage as FB.Image ptr)
declare sub bresenham_line(x0 As Integer, y0 As Integer, x1 As Integer, y1 As Integer)
declare function get_perimeter_points() as integer
private:
as integer v0_x, v0_y, v1_x, v1_y, v2_x, v2_y, v3_x, v3_y, _
x0_clip, y0_clip, x1_clip, y1_clip
as ULong _color
redim points (0 to 0, 0 to 1) as integer
redim y_pairs (0 to 0, 0 to 2) as integer
end type
function quad.get_perimeter_points() as integer
return Ubound(points)-1
End function
Sub quad.set_up( x0 as integer, y0 as integer, _
x1 as integer, y1 as integer, _
x2 as integer, y2 as integer, _
x3 as integer, y3 as integer, _
c as Ulong, _
x0_cl as integer, y0_cl as integer,_
x1_cl as integer, y1_cl as integer)
this.v0_x = x0 : this.v0_y = y0
this.v1_x = x1 : this.v1_y = y1
this.v2_x = x2 : this.v2_y = y2
this.v3_x = x3 : this.v3_y = y3
this.x0_clip = x0_cl : this.y0_clip = y0_cl
this.x1_clip = x1_cl : this.y1_clip = y1_cl
redim points (0 to 0, 0 to 1) as integer
redim y_pairs (0 to 0, 0 to 2) as integer
this.make_quad()
this.sort_points(Lbound(points), Ubound(points))
this.make_y_point_pairs()
this._color = c
End sub
sub quad._draw (pImage as FB.Image ptr)
dim i as integer
for i = Lbound(this.y_pairs) to Ubound(this.y_pairs)-1
line pImage, ( this.y_pairs(i,0),_
this.y_pairs (i,1))-_
( this.y_pairs(i,0), _
this.y_pairs (i,2)), this._color
next i
end sub
'source: https://rosettacode.org/wiki/Sorting_algorithms/Quicksort#FreeBASIC
' quick sort
'a bit modified in order to sort the first column a two dimensional array
Sub quad.sort_points(l As Long, r As Long)
Dim As ULong size = r - l +1
If size < 2 Then Exit Sub
Dim As Long i = l, j = r
Dim As Long pivot = points(l + size \ 2, 0)
Do
While points(i,0) < pivot
i += 1
Wend
While pivot < points(j,0)
j -= 1
Wend
If i <= j Then
Swap points(i,0), points(j,0)
Swap points(i,1), points(j,1)
i += 1
j -= 1
End If
Loop Until i > j
If l < j Then this.sort_points(l, j)
If i < r Then this.sort_points(i, r)
End Sub
sub quad.make_y_point_pairs()
dim as integer i, j, max, min, x_value, k, old_max, old_min
i = 0
k = 0
while i < Ubound(this.points)-1
x_value = this.points(i,0)
max = this.points(i,1)
min = this.points(i,1)
while this.points(i,0) = x_value andAlso i < Ubound(this.points)
if this.points(i,1) > max then max = this.points(i,1)
if this.points(i,1) < min then min = this.points(i,1)
i +=1
wend
this.y_pairs(k, 0) = x_value
this.y_pairs(k, 1) = min
this.y_pairs(k, 2) = max
redim preserve this.y_pairs(0 to Ubound(this.y_pairs)+1, 0 to 2)
k +=1
wend
end sub
Sub quad.make_quad ()
this.bresenham_line(this.v0_x, this.v0_y, this.v1_x, this.v1_y)
this.bresenham_line(this.v1_x, this.v1_y, this.v2_x, this.v2_y)
this.bresenham_line(this.v2_x, this.v2_y, this.v3_x, this.v3_y)
this.bresenham_line(this.v3_x, this.v3_y, this.v0_x, this.v0_y)
end sub
' modified source from
' http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#FreeBASIC
' Ported from the C version
Sub quad.bresenham_line(x0 As Integer, y0 As Integer, x1 As Integer, y1 As Integer)
Dim As Integer dx = Abs(x1 - x0), dy = Abs(y1 - y0)
Dim As Integer sx = IIf(x0 < x1, 1, -1)
Dim As Integer sy = IIf(y0 < y1, 1, -1)
Dim As Integer er = IIf(dx > dy, dx, -dy) \ 2, e2
Do
'clipping
if x0 > x0_clip andAlso x0 < x1_clip AndAlso _
y0 > y0_clip andAlso y1 < y1_clip then
this.points (Ubound(this.points), 0) = x0
this.points (Ubound(this.points), 1) = y0
redim preserve this.points(0 to Ubound(this.points)+1, 0 to 1)
end if
If (x0 = x1) And (y0 = y1) Then Exit Do
e2 = er
If e2 > -dx Then Er -= dy : x0 += sx
If e2 < dy Then Er += dx : y0 += sy
Loop
End Sub
'translated by UEZ
' https://www.freebasic.net/forum/viewtopic.php?f=3&t=29154&p=279754&hilit=thick+line#p279754
' from source http://members.chello.at/easyfilter/canvas.html
Sub DrawLineW2(x0 As Long, y0 As Long, x1 As Long, y1 As Long, th As Single, col As Ulong, pImage as FB.Image ptr)
Dim As Long dx = Abs(x1 - x0), sx = Iif(x0 < x1, 1, -1), dy = Abs(y1 - y0), sy = Iif(y0 < y1, 1, -1)
Dim As Single er, e2 = Sqr(dx * dx + dy * dy), alpha
If (th <= 1 or e2 = 0) Then
Line pImage, (x0, y0) - (x1, y1), col
Exit Sub
End If
dx *= 255 / e2
dy *= 255 / e2
th = 255 * (th - 1)
Dim As Ulong c = (col And &hFFFFFF)
If (dx < dy) Then
x1 = round((e2 + th / 2) / dy)
er = x1 * dy - th / 2
x0 -= x1 * sx
While (y0 <> y1)
y0 += sy
x1 = x0
alpha = 255 - er
Pset pImage, (x1, y0), (alpha Shl 24) Or c
e2 = dy - er - th
While (e2 + dy < 255)
e2 += dy
x1 += sx
Pset pImage, (x1, y0), col
Wend
alpha = 255 - e2
Pset pImage, (x1 + sx, y0), (alpha Shl 24) Or c
er += dx
If (er > 255) Then
er -= dy
x0 += sx
End If
Wend
Else
y1 = round((e2 + th / 2) / dx)
er = y1 * dx - th / 2
y0 -= y1 * sy
While (x0 <> x1)
x0 += sx
y1 = y0
alpha = 255 - er
Pset pImage, (x0, y1), (alpha Shl 24) Or c
e2 = dx - er - th
While (e2 + dx < 255)
e2 += dx
y1 += sy
Pset pImage, (x0, y1), col
Wend
alpha = 255 - e2
Pset pImage, (x0, y1 + sy), (alpha Shl 24) Or c
er += dy
If (er > 255) Then
er -= dx
y0 += sy
End If
Wend
End If
End Sub
'bresenham line + circle
sub thick_line_circle( x0 As Long, y0 As Long,_
x1 As Long, y1 As Long,_
thickness as Long, _color as ULong, _
pImage as FB.Image ptr)
Dim As Long dx = Abs(x1 - x0), dy = Abs(y1 - y0)
Dim As Long sx = IIf(x0 < x1, 1, -1)
Dim As Long sy = IIf(y0 < y1, 1, -1)
Dim As Long er = IIf(dx > dy, dx, -dy) \ 2, e2
dim as Long radius
radius = thickness\2
Do
circle pImage, (x0,y0), radius, _color,, , ,F
If (x0 = x1) And (y0 = y1) Then Exit Do
e2 = er
If e2 > -dx Then Er -= dy : x0 += sx
If e2 < dy Then Er += dx : y0 += sy
Loop
End Sub
screenres (SCR_W, SCR_H, 24)
dim canvas as FB.Image ptr
canvas = IMAGECREATE (SCR_W, SCR_H)
dim as Long w2 = SCR_W \ 4, h2 = SCR_H \ 4, i, w = 20
Dim As Single r = 100, x1 = w2, y1 = h2, x2, y2, angle1, angle2, thickness = 50, tn = thickness / 2
dim as double time_begin, time_elapsed_scanline, time_elapsed_thickline, _
time_elapsed_bresenham_triangle, time_elapsed_bresenham_quad, _
time_elapsed_thickline_UEZ, time_elapsed_thick_circle, _
t = 0
dim p(0 to 4, 0 to 1) as Long
dim tr(0 to 1) as triangle
dim qd as quad
do
line canvas, (0,0)-(SCR_W, SCR_H), &hFFFFFF, BF
x2 = w2 + Cos(t) * r
y2 = h2 + Sin(t) * r
angle1 = Atan2(y2 - y1, x2 - x1) + pi2
angle2 = Atan2(y2 - y1, x2 - x1) - pi2
'Bresenham thick line test
time_begin = timer
plotLineWidth(w2, h2, x2, y2, thickness, &hDADADA, canvas)
time_elapsed_thickline = timer - time_begin
'Bresenham thick line test (UEZ translation)
time_begin = timer
DrawLineW2(w2, h2+ SCR_H\3, x2, y2+ SCR_H\3, thickness, &HA0A0A0, canvas)
time_elapsed_thickline_UEZ = timer - time_begin
p (0,0) = x1 + tn * Cos(angle1) + SCR_W \ 4
p (0,1) = y1 + tn * Sin(angle1)
p (1,0) = x1 + tn * Cos(angle2) + SCR_W \ 4
p (1,1) = y1 + tn * Sin(angle2)
p (2,0) = x2 + tn * Cos(angle2) + SCR_W \ 4
p (2,1) = y2 + tn * Sin(angle2)
p (3,0) = x2 + tn * Cos(angle1) + SCR_W \ 4
p (3,1) = y2 + tn * Sin(angle1)
'Bresenham triangle test
time_begin = timer
tr(0).set_up( p(0,0)+ SCR_W \ 4, p (0,1), _
p(1,0)+ SCR_W \ 4, p (1,1), _
p (2,0)+ SCR_W \ 4, p(2,1), _
&h00FFFF,_
0,0,SCR_W, SCR_H)
tr(1).set_up( p(0,0)+ SCR_W \ 4, p (0,1), _
p(2,0)+ SCR_W \ 4, p (2,1), _
p (3,0)+ SCR_W \ 4, p(3,1), _
&h0000FF,_
0,0,SCR_W, SCR_H)
for i = 0 to Ubound(tr)
tr(i)._draw(canvas)
next i
time_elapsed_bresenham_triangle = timer - time_begin
'Bresenham quad test
time_begin = timer
qd.set_up( p(0,0)+ SCR_W \ 4, p (0,1) + SCR_H\3, _
p(1,0)+ SCR_W \ 4, p (1,1) + SCR_H\3, _
p (2,0)+ SCR_W \ 4, p(2,1) + SCR_H\3, _
p (3,0)+ SCR_W \ 4, p(3,1) + SCR_H\3, _
&h00FFFF,_
0,0,SCR_W, SCR_H)
qd._draw(canvas)
time_elapsed_bresenham_quad = timer - time_begin
'scanline fill test
time_begin = timer
fill_polygon(p(), &hFF00FF, canvas)
time_elapsed_scanline = timer - time_begin
'thick line made by a circle over a bresenham line test
time_begin = timer
thick_line_circle(w2+ SCR_W \ 4, h2+ SCR_H\3, x2+ SCR_W \ 4, y2+ SCR_H\3, thickness, &hAA00FF, canvas)
time_elapsed_thick_circle = timer - time_begin
t += 0.05
draw string canvas, ((SCR_W\4) , SCR_H - 120),"thick line circle: " + str(time_elapsed_thick_circle), &hAA00FF
draw string canvas, ((SCR_W\4) , SCR_H - 100),"scanline: " + str(time_elapsed_scanline), &hFF00FF
draw string canvas, ((SCR_W\4) , SCR_H - 80), "bresenham thick line: " + str(time_elapsed_thickline), &hDADADA
draw string canvas, ((SCR_W\4) , SCR_H - 60), "bresenham double triangle: " + str(time_elapsed_bresenham_triangle), &h0000FF
draw string canvas, ((SCR_W\4) , SCR_H - 40), "bresenham quad: " + str(time_elapsed_bresenham_quad), &h00FFFF
draw string canvas, ((SCR_W\4) , SCR_H - 20), "bresenham thick line (UEZ):" + str(time_elapsed_thickline_UEZ), &hA0A0A0
screenlock
put (0,0), canvas, pset
screenunlock
sleep 200,1
Loop Until Len(Inkey())
ImageDestroy canvas