Fast clipping lines in BASIC.

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Fast clipping lines in BASIC.

Post by D.J.Peters »

http://en.wikipedia.org/wiki/Cohen-Sutherland
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
Last edited by D.J.Peters on Dec 25, 2018 13:08, edited 2 times in total.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Fast clipping lines in BASIC.

Post by D.J.Peters »

Updated is 64-bit compatible now
The BASIC version is faster as the clipped lines in C from fbgfx library :-)

Joshy
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Fast clipping lines in BASIC.

Post by D.J.Peters »

I replaced the function findRegion with a macro.

Joshy
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Fast clipping lines in BASIC.

Post by leopardpm »

Excellent Joshy! I always like when anyone is able to outperform the standard FB routines and yours seems about 3x faster on my machine, very significant improvement. Is there anything the FB version does (or can do) that your routine doesn't?

and, am I reading it right? You seem to pre-generate the RND values and then AND your way through the table, basically generating RNDs very fast, but making sure each routine gets the exact same values - thereby ensuring that the time effect on each routine for the RND points is minimized and the line drawing speed is maximized, right?

EDIT: nope, i was wrong... you still have RND within the bigger loop.... why are you doing it this way?
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Fast clipping lines in BASIC.

Post by jj2007 »

leopardpm wrote:you still have RND within the bigger loop.... why are you doing it this way?
Compared to drawing lines etc, generating a random number is incredibly fast, at least when you use one of deltarho's high quality algos (PCG32-II, for example). So don't worry about seeing them in an innermost loop.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Fast clipping lines in BASIC.

Post by D.J.Peters »

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
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Fast clipping lines in BASIC.

Post by D.J.Peters »

Ups I found a bug you too :-)

fixed see first post

Joshy
Last edited by D.J.Peters on Dec 25, 2018 13:09, edited 1 time in total.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Fast clipping lines in BASIC.

Post by leopardpm »

slower now... but still almost 2x faster than FBGX
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Fast clipping lines in BASIC.

Post by leopardpm »

D.J.Peters wrote:How ever with inline assembler you would get it 2-5 times faster but my version in BASIC is remarkable fast.
...and,again, if assembler is used, then the code becomes OS dependent, or is it chip dependent?
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Fast clipping lines in BASIC.

Post by leopardpm »

Joshy, without looking at your code again, I am assuming you are using a Bresenham variant to draw your lines... have you seen or compared the speed of that to a Linear Interpolation method (see https://www.redblobgames.com/grids/line-drawing.html)?

I always assumed Bresenham was the fastest/simplest method but am interested in seeing the speed diff between the two...
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Fast clipping lines in BASIC.

Post by D.J.Peters »

My interpretation of Bresenham algo differs from the original.

The "normal" algo are:
go from point A to point B and plot all the pixels on the line.

pseudo code:
loop over x or y distance
..calculate x,y : set pixel at x,y
..distance-=1
repeat if distance>0

my version used not x,y instead I us pointer pStart (point A) and pointer pEnd (point B)
the trick are move pStart in direction from Point A to Point B
and move pEnd in direction from Point B to Point A.
the line are finish if pStart and pEnd meets together.

With other words my loop counter counts only the half of the x or y distance.

pseudo code:
half_distance = x or y distance / 2
loop over half_distance
..*pStart=color : *pEnd=color
.. move pStart in "+" direction move pEnd in "-" direction
..half_distance -=1
repeat if half_distance >0

I know some of you will think I'm wrong both are the same:

But it isn't (trust me)

version 1:
for i=1 to 10
..set x,y,color
..calculate new x
..calculate new y
next

version 2:
for i=1 to 5 <-- the half
..*pStart=color : *pEnd=color
..calculate new pStart
..calculate new pEnd
next

I hope that makes sense :-)

Joshy
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Fast clipping lines in BASIC.

Post by leopardpm »

D.J.Peters wrote:I know some of you will think I'm wrong both are the same:
I don't think they are 'the same', but I think both are basically the same speed, right? You loop only 1/2 the times, but plot 2x the points each time... actually, when there is perhaps an uneven amount of points, then yours might plot an 'extra' point over top the 'normal' way... right?
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Fast clipping lines in BASIC.

Post by dodicat »

D.J.Peters.
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


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 : 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"

Dim As Double t2=Timer()

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

t2=Timer()-t2
? "BASIC = " & t1
? "other = " & t2
Sleep  
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Re: Fast clipping lines in BASIC.

Post by sancho3 »

I remember this code from way back in another thread and it is the fastest I have seen.
There is an anomaly that is very minor but may impact the way this is used.
The outputed line does not always match that which comes from the Line command.
You can see the artifacts left using this code:

Code: Select all

screenres 800,600,32
'Line32(Screenptr, 0,10, 100,10, Rgb(0,200,0))
For i As Integer = 0 To 800
	bLine(Screenptr, i,0, 400,100, Rgb(0,200,0))
	Line(i,0)-(400,100), Rgb(0,0,200) 
Next 

Sleep 

So that tells me that the points being calculated do not match exactly the algorithm used by Line; perhaps a rounding discrepancy.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Fast clipping lines in BASIC.

Post by D.J.Peters »

leopardpm wrote:... I think both are basically the same speed, right?
No the loop counter and loop jump needs time also ...
leopardpm wrote:... when there is perhaps an uneven amount of points, then yours might plot an 'extra' point over top the 'normal' way right?
Yes div by 2 will miss one point if odd but I set it manual.
if dy and 1 then *pEnd=Col
if dx and 1 then *pEnd=Col

Joshy
Post Reply