The triangle class:
Code: Select all
'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)
declare sub make_triangle ()
declare sub make_y_point_pairs ()
declare sub sort_points ()
declare sub _draw ()
declare sub bresenham_line(x0 As Integer, y0 As Integer, x1 As Integer, y1 As Integer)
private:
as integer v0_x, v0_y, v1_x, v1_y, v2_x, v2_y
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
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)
this.v0_x = x0 : this.v0_y = y0
this.v1_x = x1 : this.v1_y = y1
this.v2_x = x2 : this.v2_y = y2
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()
this.make_y_point_pairs()
this._color = c
End sub
sub triangle._draw ()
dim i as integer
for i = Lbound(this.y_pairs) to Ubound(this.y_pairs)-1
line ( 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/Insertion_sort#FreeBASIC
' insertion sort
'a bit modified in order to sort the first column a two dimensional array
Sub triangle.sort_points()
' sort from lower bound to the higher bound
Dim As Long lb = LBound(this.points)
Dim As Long i, j, value
dim as integer row_x, row_y
For i = lb +1 To UBound(this.points)-1
value = this.points(i, 0)
row_x = this.points(i,0)
row_y = this.points(i,1)
j = i -1
While j >= lb Andalso this.points(j, 0) > value
this.points(j +1, 0) = this.points(j, 0)
this.points(j +1, 1) = this.points(j, 1)
j = j -1
Wend
this.points(j+1,0) = row_x
this.points(j+1,1) = row_y
Next
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
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)
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
Code: Select all
'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
'step 1 - make bresenham lines and store Cartesian coordinates
' of each point of these lines into a 2d array
'..........
'........##
'....####.#
'####....#.
'.#......#.
'..#....#..
'...#...#..
'...#..#...
'....#.#...
'.....#....
'step 2 - sort the 2d array containing these points by x value
'..........
'........89
'....4567.9
'0123....8.
'.1......8.
'..2....7..
'...3...7..
'...3..6...
'....4.6...
'.....5....
'step 3 - for each x coordinate find the largest and smallest y value
'..........
'........@@
'....@@@@.@
'@@@@....#.
'.@......@.
'..@....#..
'...#...@..
'...@..#...
'....@.@...
'.....@....
'step 4 - draw a vertical line joining the two opposite points
' on the y axis
'..........
'........@@
'....@@@@I@
'@@@@IIIII.
'.@IIIIII@.
'..@IIIII..
'...IIII@..
'...@III...
'....@I@...
'.....@....
#INCLUDE "fbgfx.bi"
#INCLUDE "bresenham_triangle.bi"
#DEFINE SCR_W 640
#DEFINE SCR_H 480
#DEFINE SPAN 20
dim as integer _x, _y, i
Randomize Timer
ScreenRes SCR_W, SCR_H, 32
WindowTitle" Press key to end demo"
dim t(0 to 999) as triangle
dim time_diff as double
for i = 0 to Ubound(t)
_x = rnd*SCR_W
_y = rnd*SCR_H
t(i).set_up( _x, _y, _
_x + rnd*(SPAN), _y + rnd*(SPAN), _
_x + rnd*(SPAN), _y + rnd*(SPAN), _
rnd * &hFFFFFF)
next
time_diff = timer
for i = 0 to Ubound(t)
t(i)._draw
next i
draw string (50, SCR_H - 20), str(i) + " triangles in " + str (timer - time_diff)
sleep
End