http://en.wikipedia.org/wiki/Bresenham% ... _algorithm
Joshy
Code: Select all
' Test for "optimized" cohen sutherland clipping and bresenham line algo.
const as integer scr_w = 800
const as integer scr_h = 600
' clipping region view (50,50)-(scr_h-50,scr_h-50)
const as single minx = 50
const as single maxx = scr_w-50
const as single miny = 50
const as single maxy = scr_h-50
sub BLine(byval pPixels as ulong ptr, _
byval x1 as integer, byval y1 as integer, _
byval x2 as integer, byval y2 as integer, _
byval Col as ulong)
dim as integer xy=any,E=any,EX=any,EY=any
dim as integer dx=x2-x1, dy=y2-y1, x=1, y=scr_w
dim as ulong ptr pStart = pPixels,pEnd = pPixels
if (dx<0) then dx=-dx : x=-1
if (dy<0) then dy=-dy : y=-scr_w
xy = x+y
pStart=@pstart[y1*scr_w+x1]
pEnd =@pend [y2*scr_w+x2]
if dy>dx then
E=-dy : EY=E shl 1 : EX=dx shl 1 : dx=dy shr 1
do
*pStart=Col : *pEnd=Col : E+=EX
if E<0 then
pStart+=y : pEnd -=y
else
pStart+=xy : pEnd -=xy : E+=EY
end if
dx-=1
loop while dx>0
*pStart=Col : if dy and 1 then *pEnd=Col
else
E=-dx : EX=E shl 1 : EY=dy shl 1 : dy=dx shr 1
do
*pStart=Col : *pEnd=Col : E+=EY
if E<0 then
pStart+=x : pEnd-=x
else
pStart+=xy: pEnd-=xy : E+=EX
end if
dy-=1
loop while dy>0
*pStart=Col : if dx and 1 then *pEnd=Col
end if
end sub
enum eClipCode
YMAX=1
YMIN=2
XMAX=4
XMIN=8
end enum
#define findXCode(x_) iif(x_<minx,XMIN,iif(x_>=maxx,XMAX,0))
#define findYCode(y_) iif(y_<miny,YMIN,iif(y_>=maxy,YMAX,0))
#define findRegion(x_,y_) findXCode(x_) or findYCode(y_)
sub Line32(byval pMem as any ptr, _
byval x1 as single, byval y1 as single, _
byval x2 as single, byval y2 as single, _
byval c as ulong)
dim as single x=any,y=any,xd=any,yd=any
dim as integer accept, done
var code1 = findRegion(x1, y1)
var code2 = findRegion(x2, y2)
do
if (code1 or code2)=0 then
accept = 1 : done = 1
elseif code1 and code2 then
done = 1
else
xd = x2 - x1 : yd = y2 - y1
var codeout = iif(code1,code1,code2)
if (codeout and XMIN) then
y = y1 + yd * -x1 / xd
x = minx
elseif (codeout and XMAX) then
y = y1 + yd * (maxx - x1) / xd
x = maxx - 1
elseif (codeout and YMIN) then
x = x1 + xd * -y1 / yd
y = miny
elseif (codeout and YMAX) then
x = x1 + xd * (maxy - y1) / yd
y = maxy - 1
end if
if codeout = code1 then
x1 = x : y1 = y : code1 = findRegion(x1, y1)
else
x2 = x : y2 = y : code2 = findRegion(x2, y2)
end if
end if
loop while (done=0)
if (accept) then bline(pMem,x1,y1,x2,y2,c)
end sub
screenres scr_w,scr_h,32
dim as single x1,y1,x2,y2
dim as any ptr pVideo
dim as integer xr,yr,cr
dim as ulong colour
dim as single w(1023),h(1023)
dim as integer c(1023)
for i as integer = 0 to 1023
w(i)=rnd*scr_w
h(i)=rnd*scr_h
c(i)=rgb(rnd*255,rnd*255,rnd*255)
next
windowtitle "BASIC"
pVideo=ScreenPtr()
dim as double t1=Timer()
for n as integer=1 to 10000
cr=rnd*1023:xr=rnd*1023:yr=rnd*1023
ScreenLock
for x as integer=1 to 200
colour=c(cr and 1023):cr+=1
x1=w(xr and 1023):xr+=1
y1=h(yr and 1023):yr+=1
x2=w(xr and 1023):xr+=1
y2=h(yr and 1023):yr+=1
Line32 pVideo,x1,y1,x2,y2,colour
next
ScreenUnlock
next
t1=timer()-t1
windowtitle "FBGFX"
view (minx,miny)-(maxx,maxy)
dim as double t2=Timer()
for n as integer=1 to 10000
cr=rnd*1023:xr=rnd*1023:yr=rnd*1023
ScreenLock
for x as integer=1 to 200
colour=c(cr and 1023):cr+=1
x1=w(xr and 1023):xr+=1
y1=h(yr and 1023):yr+=1
x2=w(xr and 1023):xr+=1
y2=h(yr and 1023):yr+=1
Line (x1,y1)-(x2,y2),colour
next
ScreenUnlock
next
t2=timer()-t2
? "BASIC = " & t1
? "FBGFX = " & t2
sleep