Yes if I'm back at home.dodicat wrote:Could you check your clipping at 45 degrees.
No one says a Line must hit the same points but I will check it if I'm back at home.sancho3 wrote:So that tells me that the points being calculated do not match exactly the algorithm used by Line; perhaps a rounding discrepancy.
sure I donn't know what you doing but with my unchanged version here from forum it works !dodicat wrote:Could you check your clipping at 45 degrees.
Code: Select all
' Test for cohen sutherland clipping and bresenham line algo.
Const As Integer scr_w = 800
Const As Integer scr_h = 600
' clipping region view (0,0)-(scr_h-1,scr_h-1)
Const As Single minx =0
Const As Single maxx =799
Const As Single miny =0
Const As Single maxy =599
Type screendata
As Integer w,h,pitch
As Any Pointer row
End Type
Sub bline2(sd As screendata,x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,col As Ulong)
#define ppset32(_x,_y,colour) *Cptr(Ulong Ptr,sd.row+ (_y)*sd.pitch+ (_x) Shl 2) =(colour)
Dim As Integer dx=Abs(x2-x1),dy=Abs(y2-y1),sx=Sgn(x2-x1),sy=Sgn(y2-y1)
Dim As Integer e
If dx<dy Then e=dx\2 Else e=dy\2
Do
If x1>-1 Then
If x1<sd.w Then
If y1>-1 Then
If y1<sd.h Then
ppset32((x1),(y1),col)
End If
End If
End If
End If
If x1 = x2 Then If y1 = y2 Then Exit Do
If dx > dy Then
x1 += sx : e -= dy : If e < 0 Then e += dx : y1 += sy
Else
y1 += sy : e -= dx : If e < 0 Then e += dy : x1 += sx
End If
Loop
End Sub
' 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 = 0
const as single maxx = scr_w-1
const as single miny = 0
const as single maxy = scr_h-1
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 screendata s
With s
Screeninfo .w,.h,,,.pitch
.row=Screenptr
End With
Dim As Single x1,y1,x2,y2
Dim As Any Ptr pVideo
Windowtitle "BASIC"
pVideo=Screenptr()
Dim As Double t1=Timer()
Screenlock
x1=-50
y1=-50
x2=1000
y2=1000
Line32 pVideo,x1,y1,x2,y2,Rgb(200,0,0)
Screenunlock
t1=Timer()-t1
Locate 12
Print "Press a key"
Sleep
Windowtitle "other"
Screenlock
x1=-50
y1=-50
x2=1000
y2=1000
' line(x1,y1)-(x2,y2),rgb(0,200,0)
bline2(s,(x1),(y1),(x2),(y2),Rgb(0,200,0))
Screenunlock
sleepCode: 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 = 0
const as single maxx = scr_w-1
const as single miny = 0
const as single maxy = scr_h-1
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,2
screenset 1,0
dim as single x1,y1,x2,y2
dim as any ptr pVideo
dim as integer xr,yr,cr
dim as ulong colour
windowtitle "BASIC"
pVideo=ScreenPtr()
'Line32(Screenptr, 0,10, 100,10, Rgb(0,200,0))
For i As Integer = 0 To scr_w-1 step 3
Line(i,0)-(scr_w/2,scr_h-1), Rgb(0,255,0)
flip
Next
sleep 1000
For i As Integer = 0 To scr_w-1 step 3
BLine(Screenptr, i,0, scr_w/2,scr_h-1, Rgb(255,0,0))
flip
Next
print "identical press a key"
flip
sleep
for y as integer=scr_h-1 to 0 step -1
cls
For i As Integer = 0 To scr_w-1 step 1
Line (i,0)-(400,y), Rgb(0,255,0)
bLine(Screenptr, i,0, 400,y, Rgb(255,0,0))
Next
print "small interferences"
flip
sleep 10
next
sleepTrue; possibly more, but is an unfair comparison (BASIC & Asm) as assembler is faster than anything out there.D.J.Peters wrote:RND in the outer loop is OK but in the inner loop you will measurement the speed off RND and the line drawing so using an array is not a bad idea.
How ever with inline assembler you would get it 2-5 times faster but my version in BASIC is remarkable fast.
Joshy