Already posted it months ago in some topic with questions, just this time it is a bit closer to a good gode, unlike first primitive/unsafe version ported from wiki even without variables declarations ^^
PS. There are also other code examples on forum, the difference is that here only necessary procedure code + example is posted, without lot of unused code dependencies (like declares, whole modules and other bureaucratic trash you need to remove before using the code)
Code: Select all
EnableExplicit
; Used to draw line by defining it's start/end points (without antialiasing)
; Matrix() a two-dimensional array which represents image. X is first dimension, Y second
; X1, Y1 first point where line starts
; X2, Y2 line end point coordinates (may be <> X1, Y1)
; Color line color
; RETURN: none, matrix modified
Procedure BresenhamLine (Array Matrix(2), X1, Y1, X2, Y2, Color)
Protected.d dX, dY, Error
Protected.i X, Y, maxX, maxY, stepY, inverted
; prepare main stuff
dX = Abs(X2 - X1)
dY = Abs(Y2 - Y1)
Error = dX * 0.5
maxX = ArraySize(Matrix(), 1)
maxY = ArraySize(Matrix(), 2)
; invert variables to always use X as main iterator
If dY > dX
Swap X1, Y1
Swap X2, Y2
inverted = #True
EndIf
; invert also X1/X2 variables, to move loop always from X1 to X2, using default step 1 (as PB won't allow variable to be used as For step)
If X1 > X2
Swap X1, X2
Swap Y1, Y2
EndIf
; prepare other stuff which depends on swapped values
stepY = -Int(Sign(Y1 - Y2)) ; If Y1<Y2: step = -1. IF Y2>Y1: step = 1. Else: step = 0.
Y = Y1
; process path points
For X = X1 To X2
If inverted
Swap X, Y ; switching to allow user use x, y as it expected
EndIf
; check matrix bounds to avoid buffer overflow or other problems
If (X >= 0 And X <= maxX) And (Y >= 0 And Y <= maxY)
; in this block matrix may be normally referenced using X/Y values
; do not change x/y variables here
Matrix(X, Y) = Color
EndIf
If inverted
Swap X, Y ; switching back to continue loop
EndIf
Error - dY
If Error < 0
Y + stepY
Error + dX
EndIf
Next
EndProcedure
; example
; some matrix to store image
Dim N(10, 4)
; draw "image" lines ^^
BresenhamLine(N(), 0, 0, 0, 4, Random(9, 1))
BresenhamLine(N(), 0, 4, 4, 4, Random(9, 1))
BresenhamLine(N(), 6, 0, 10, 0, Random(9, 1))
BresenhamLine(N(), 6, 0, 6, 2, Random(9, 1))
BresenhamLine(N(), 6, 2, 10, 2, Random(9, 1))
BresenhamLine(N(), 10, 2, 10, 4, Random(9, 1))
BresenhamLine(N(), 6, 4, 10, 4, Random(9, 1))
; print results
Define tX, tY, t$
For tY = 0 To ArraySize(N(), 2)
For tX = 0 To ArraySize(N(), 1)
If N(tx, ty)
t$ + Str(N(tx, ty))
Else
t$ + " "
EndIf
Next tX
Debug t$
t$ = ""
Next tY