Bresenham thick line code

[UEZ]

I'm trying to convert following Bresenham thick line code to FB but the result isn't what I expect.

http://members.chello.at/easyfilter/canvas.html

C code:

Code: Select all

/**
 * @author Zingl Alois
 * @date 22.08.2016
 * @version 1.2
*/
void plotLineWidth(int x0, int y0, int x1, int y1, float wd)
    { /* plot an anti-aliased line of width wd */
        int dx = abs(x1 - x0), sx = x0 < x1 ? 1 : -1;
        int dy = abs(y1 - y0), sy = y0 < y1 ? 1 : -1;
        int err = dx - dy, e2, x2, y2; /* error value e_xy */
        float ed = dx + dy == 0 ? 1 : sqrt((float)dx * dx + (float)dy * dy);

        for (wd = (wd + 1) / 2;;) { /* pixel loop */
            setPixelColor(x0, y0, max(0, 255 * (abs(err - dx + dy) / ed - wd + 1)));
            e2 = err;
            x2 = x0;
            if (2 * e2 >= -dx) { /* x step */
                for (e2 += dy, y2 = y0; e2 < ed * wd && (y1 != y2 || dx > dy); e2 += dx)
                    setPixelColor(x0, y2 += sy, max(0, 255 * (abs(e2) / ed - wd + 1)));
                if (x0 == x1)
                    break;
                e2 = err;
                err -= dy;
                x0 += sx;
            }
            if (2 * e2 <= dy) { /* y step */
                for (e2 = dx - e2; e2 < ed * wd && (x1 != x2 || dx < dy); e2 += dy)
                    setPixelColor(x2 += sx, y0, max(0, 255 * (abs(e2) / ed - wd + 1)));
                if (y0 == y1)
                    break;
                err += dx;
                y0 += sy;
            }
        }
    }

JS code:

Code: Select all

/**
  * Bresenham Curve Rasterizing Algorithms
  * @author  Zingl Alois
  * @date    17.12.2014
  * @version 1.3
  * @url     http://members.chello.at/easyfilter/bresenham.html
  */
 function plotLineWidth(x0, y0, x1, y1, th) {
  /* plot an anti-aliased line of width th pixel */
  var dx = Math.abs(x1 - x0),
      sx = x0 < x1 ? 1 : -1;
	  
  var dy = Math.abs(y1 - y0),
      sy = y0 < y1 ? 1 : -1;
	  
  var er, e2 = Math.sqrt(dx * dx + dy * dy); /* length */

  if (th <= 1 || e2 == 0) 
	return plotLineAA(x0, y0, x1, y1); /* assert */
  
  dx *= 255 / e2;
  dy *= 255 / e2;
  th = 255 * (th - 1); /* scale values */

  if (dx < dy) {
    /* steep line */
    x1 = Math.round((e2 + th / 2) / dy); /* start offset */
    er = x1 * dy - th / 2; /* shift error value to offset width */
    x0 -= x1 * sx;
	
	while (y0 != y1){
	  y0 += sy;	
	  x1 = x0;
      setPixelAA(x1, y0, er); /* aliasing pre-pixel */
	  e2 = dy - er - th;
      while (e2 + dy < 255){
		   e2 += dy;
		   x1 += sx;
		   setPixel(x1, y0); /* pixel on the line */
	  }
      setPixelAA(x1 + sx, y0, e2); /* aliasing post-pixel */
      //if (y0 == y1) break;
      er += dx; /* y-step */
      if (er > 255) {
        er -= dy;
        x0 += sx;
      } /* x-step */
    }
  } else {
    /* flat line */
    y1 = Math.round((e2 + th / 2) / dx); /* start offset */
    er = y1 * dx - th / 2; /* shift error value to offset width */
	y0 -= y1 * sy;
    while (x0 != x1){
	  x0 += sx;
	  y1 = y0;
      setPixelAA(x0, y1, er); /* aliasing pre-pixel */
      e2 = dx - er - th;
	  while (e2 + dx < 255){
		   e2 += dx;
		   y1 += sy;
           setPixel(x0, y1); /* pixel on the line */
	  }
      setPixelAA(x0, y1 + sy, e2); /* aliasing post-pixel */
      //if (x0 == x1) break;
      er += dy; /* x-step */
      if (er > 255) {
        er -= dx;
        y0 += sy;
      } /* y-step */
    }
  }
} 

What I did:

Code: Select all

#Include "fbgfx.bi"
#Include "crt/math.bi"

Using FB

#Define Max(a, b)		(Iif(a > b, a, b))
#Define Min(a, b)		(Iif(a < b, a, b))

Sub DrawLineW(x0 As Long, y0 As Long, x1 As Long, y1 As Long, wd As Single, col As Ulong, pImage As Any Ptr = 0)
	Dim As Long dx = Abs(x1 - x0), sx = Iif(x0 < x1, 1, -1), dy = Abs(y1 - y0), sy = Iif(y0 < y1, 1, -1), er = dx - dy, e2, x2, y2
	Dim As Single ed = Iif(dx + dy = 0, 1, Sqr(dx * dx + dy * dy)), alpha
	Dim As Ulong c = (col And &hFFFFFF)
	
	wd = (wd + 1) / 2
	While True
		alpha = 255 - Max(0, 255 * (Abs(er - dx + dy) / ed - wd + 1))
		Pset pImage, (x0, y0), (alpha Shl 24) Or c
		e2 = er
		x2 = x0
		If 2 * e2 >= -dx Then
			e2 += dy
			y2 = y0
			While e2 < ed * wd And (y1 <> y2 Or dx > dy)
				Alpha = 255 - Max(0, 255 * (Abs(e2) / ed - wd + 1))
				y2 += sy
				e2 += dx
				Pset pImage, (x0, y2), (alpha Shl 24) Or c
			Wend
			If x0 = x1 Then Exit While
			e2 = er
			er -= dy
			x0 += sx
		End If
		If 2 * e2 <= dy Then
			e2 = dx - e2
			While e2 < ed * wd And (x1 <> x2 Or dx < dy)
				alpha = 255 - max(0, 255 * (Abs(e2) / ed - wd + 1))
				e2 += dy
				x2 += sx
				Pset pImage, (x2, y0), (alpha Shl 24) Or c
			Wend
			If y0 = y1 Then Exit While
			er += dx
			y0 += sy
		End If
	Wend
End Sub

Sub DrawLineW2(x0 As Long, y0 As Long, x1 As Long, y1 As Long, th As Single, col As Ulong, pImage As Any Ptr = 0)
	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

Const iW = 1200, iH = 600, w2 = iW \ 2, h2 = iH \ 2

Screenres iW, iH, 32, 2, GFX_WINDOWED Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES
Screenset 1, 0
Color &hFF, &hFFFFFFFF

Dim As Single r = 200, x1 = w2, y1 = h2, x2, y2, angle1, angle2, thickness = 50, tn = thickness / 2
Const pi2 = Acos(-1) / 2
Dim As Double t = 0

Do
	Cls
	x2 = w2 + Cos(t) * r
	y2 = h2 + Sin(t) * r
	'DrawLineW(w2, h2, x2, y2, thickness, &hFFFF0000)
	DrawLineW2(w2, h2, x2, y2, thickness, &hFFFF0000)
	
	angle1 = Atan2(y2 - y1, x2 - x1) + pi2
	angle2 = Atan2(y2 - y1, x2 - x1) - pi2
	Line (x1 + tn * Cos(angle1), y1 + tn * Sin(angle1)) - _
		 (x1 + tn * Cos(angle2), y1 + tn * Sin(angle2)), &hFF000000
	Line (x2 + tn * Cos(angle2), y2 + tn * Sin(angle2)) - _
		 (x2 + tn * Cos(angle1), y2 + tn * Sin(angle1)), &hFF000000
	Line (x1, y1) - (x2, y2), &hFF000000
	
	Flip
	t += 0.01
	Sleep(10, 1)
Loop Until Len(Inkey())

Can you see the wrong conversation? Btw, I'm neither a C/C++ nor a JS coder and have only basic understanding.

Edit: seems that the original code produces the flips, too...

[Pitto]

Hi UEZ,

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).

Anyway, code improvements are welcome.

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

[UEZ]

Thanks Pitto for your reply.

Very interesting approachs. I like the idea with the two triangles. Thanks for sharing it. :-)

It's time that the FB GFX lib will be upgraded to a modern one...

[MrSwiss]

It's time that the FB GFX lib will be upgraded to a modern one...

That is far easier said then done ...

There is always that lang "qb" issue, where a U/Integer = 16 bit.

I'd probably use CAIRO library for 2D graphics (OS independent).