Writing to screenbuffer

General FreeBASIC programming questions.
Post Reply
Bad_Idea
Posts: 8
Joined: Sep 11, 2017 3:46

Writing to screenbuffer

Post by Bad_Idea »

Hi :)

I am kinda confused. I wrote a Sub that's writing directly to the screenbuffer. It's about 10 times faster than "Pset", but its also about 10 times slower than "Line" when drawing a line. But I don't know why:

Code: Select all

screenres 640,480,8

dim as double start

sub SetPixelFast (PosX as integer, PosY as integer, clr as ubyte, Dest as any ptr)
  Dim As UByte Ptr pixel
  pixel=Dest+(PosY*640)+(PosX)
  *pixel=clr
end sub 

cls
screenlock
start = timer
for count as integer= 1 to 1000000
	for i as integer=1 to 600
	SetPixelFast(i, 100, 5, screenptr)
	'pset (i,100),5
	next
	'Line (0,100)-(600,100),5
next 
screenunlock
Print timer-start
sleep
Does somebody know, how to draw a line faster than FreeBasics "Line"?
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Writing to screenbuffer

Post by D.J.Peters »

The FB gfx runtime are fast C code my fastes lines in BASIC are here: viewtopic.php?f=7&t=24523&p=217573

Joshy

Here are the benchmark but isn't realistic FB-gfx does clipping and use single values as params also !

Code: Select all

#ifndef __ALINE_BI__
#define __ALINE_BI__
#define RGB16(r,g,b) ((r and &B11111000) shl 9) or ((g and &B11111100) shl 4) or ((b and &B11111000) shr 3)
#define StepSign(v) (iif(0<(v),1,0)-iif((v)<0,1,0))
dim shared as integer pitch
dim shared as any ptr pixels
#macro aLine(_type_,_shift_)
  dim as integer dx=x1-x0
  dim as integer dy=y1-y0
  dim as integer sx=StepSign(dx)
  dim as integer sy=StepSign(dy)
  if dx<0 then dx=-dx
  if dy<0 then dy=-dy
  dim as integer iErr=dx-dy
  dim as integer iPitch=pitch shr _shift_
  dim as _type_ ptr p=pixels
  if (x0<>x1) or (y0<>y1) then *(p+x1+y1*iPitch)=c
  p+=x0+y0*iPitch
  if sy<0 then
    iPitch=-iPitch
  elseif sy=0 then
    iPitch=0
  end if
  do
    *p=c
    dim as integer iErr2=iErr shl 1
    if (iErr2 > -dy) then iErr-=dy:x0+=sx:p+=sx
    if (iErr2 <  dx) then iErr+=dx:y0+=sy:p+=iPitch
  loop while ((x0<>x1) or (y0<>y1))
#endmacro
sub aLine8(byval x0 as integer,byval y0 as integer,byval x1 as integer,byval y1 as integer,byval c as ubyte)
  aLine(UBYTE,0)
end sub
sub aLine16(byval x0 as integer,byval y0 as integer,byval x1 as integer,byval y1 as integer,byval c as ushort)
  aLine(USHORT,1)
end sub
sub aLine32(byval x0 as integer,byval y0 as integer,byval x1 as integer,byval y1 as integer,byval c as ulong)
  aLine(ULONG,2)
end sub
#endif '__ALINE_BI__


const as integer NUM_OF_RUNS=60
const as integer NUM_OF_LINES=10000

dim as double B8,B16,B32
dim as integer bits=8
while bits<33
  screenres 640,480,bits,2
  screenset 1,0
  windowtitle "BASIC " & bits & " bit mode"
  pixels=ScreenPtr()
  screeninfo ,,,,pitch
  select case as const bits
  case 8
    dim as ubyte c
    B8=timer()
    for n as integer=1 to NUM_OF_RUNS
      for i as integer = 1 to NUM_OF_LINES
        c=rnd*255
        aLine8 rnd*639,rnd*479,rnd*639,rnd*479,c
      next
      flip
    next
    B8=timer()-B8
    sleep 1000
  case 16
    dim as ubyte r,g,b
    B16=timer()
    for n as integer=1 to NUM_OF_RUNS
      for i as integer = 1 to NUM_OF_LINES
        r=rnd*255 : g=rnd*255 : b=rnd*255
        aLine16 rnd*639,rnd*479,rnd*639,rnd*479,RGB16(r,g,b)
      next
      flip
    next
    B16=timer()-B16    
    sleep 1000
  case 32
    dim as ubyte r,g,b
    B32=timer()
    for n as integer=1 to NUM_OF_RUNS
      for i as integer = 1 to NUM_OF_LINES
        r=rnd*255 : g=rnd*255 : b=rnd*255
        aLine32 rnd*639,rnd*479,rnd*639,rnd*479,RGB(r,g,b)
      next
      flip
    next
    B32=timer()-B32
    sleep 1000    
  end select
  bits shl=1
wend

dim as double C8,C16,C32
bits=8
while bits<33
  screenres 640,480,bits,2
  screenset 1,0
  windowtitle "C-GFX " & bits & " bit mode"
  pixels=ScreenPtr()
  screeninfo ,,,,pitch
  select case as const bits
  case 8
    dim as ubyte c
    C8=timer()
    for n as integer=1 to NUM_OF_RUNS
      for i as integer = 1 to NUM_OF_LINES
        c=rnd*255
        Line (rnd*639,rnd*479)-(rnd*639,rnd*479),c
      next
      flip
    next
    C8=timer()-c8
    sleep 1000
  case 16
    dim as ubyte r,g,b
    C16=timer()
    for n as integer=1 to NUM_OF_RUNS
      for i as integer = 1 to NUM_OF_LINES
        r=rnd*255 : g=rnd*255 : b=rnd*255
        Line (rnd*639,rnd*479)-(rnd*639,rnd*479),RGB(r,g,b)
      next
      flip
    next
    C16=timer()-C16    
    sleep 1000
  case 32
    dim as ubyte r,g,b
    C32=timer()
    for n as integer=1 to NUM_OF_RUNS
      for i as integer = 1 to NUM_OF_LINES
        r=rnd*255 : g=rnd*255 : b=rnd*255
        Line (rnd*639,rnd*479)-(rnd*639,rnd*479),RGB(r,g,b)
      next
      flip
    next
    C32=timer()-C32
    sleep 1000
  end select
  bits shl=1
wend

screenres 640,480
print "BASIC: " & b8,b16,b32
print "C GFX: " & C8,C16,C32
sleep
Bad_Idea
Posts: 8
Joined: Sep 11, 2017 3:46

Re: Writing to screenbuffer

Post by Bad_Idea »

Hmm I guess I'm still stuck with fbgfx then. :-/
Thanks anyway
fxm
Moderator
Posts: 12126
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Writing to screenbuffer

Post by fxm »

Code: Select all

screenres 640, 480, 8

dim as double start
dim as any ptr pscreen = screenptr

#macro SetPixelFast(PosX, PosY, clr, Dest)
   cptr(ubyte ptr, Dest)[PosY * 640 + PosX] = clr
#endmacro

cls
screenlock
start = timer
for count as integer = 1 to 1000000
   for i as integer = 1 to 600
      SetPixelFast(i, 100, 5, pscreen)
   next
next
screenunlock
print timer - start
sleep
Or (to avoid screen lock for too long):

Code: Select all

screenres 640, 480, 8, 2
ScreenSet 1, 0

dim as double start
dim as any ptr pscreen = screenptr

#macro SetPixelFast(PosX, PosY, clr, Dest)
   cptr(ubyte ptr, Dest)[PosY * 640 + PosX] = clr
#endmacro

cls
start = timer
for count as integer = 1 to 1000000
   for i as integer = 1 to 600
      SetPixelFast(i, 100, 5, pscreen)
   next
next
Print timer - start
screencopy
sleep
Bad_Idea
Posts: 8
Joined: Sep 11, 2017 3:46

Re: Writing to screenbuffer

Post by Bad_Idea »

That's a lot faster, thanks. :)
But still slower than fbgfx.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Writing to screenbuffer

Post by jj2007 »

Bad_Idea wrote:I wrote a Sub that's writing directly to the screenbuffer. It's about 10 times faster than "Pset", but its also about 10 times slower than "Line" when drawing a line.
One simple explanation could be that the graphics card accepts commands like "draw a line from A to B". Even x86 assembly can't compete with the GPU.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Writing to screenbuffer

Post by dodicat »

Please remember that the 64 bit compiler cannot handle direct screen with any speed.
So for 32 bit
Here is my attempt, comparing filling a shape paint/direct.

Code: Select all


Type screendata
    As Integer w,h,depth,pitch
    As Any Pointer row
End Type 

Sub bline(sd As screendata,x1 As long,y1 As long,x2 As long,y2 As long,col As Ulong)
    #define ppset32(_x,_y,colour)    *cptr(ulong ptr,sd.row+ (_y)*sd.pitch+ (_x) shl 2)  =(colour)
    #define ppset8(_x,_y,colour)     *cptr(ubyte ptr,(sd.row+(_y)* sd.pitch+(_x)))       =(colour)
    #define ppset16(_x,_y,colour)    *cptr(ushort ptr,(sd.row+(_y)* sd.pitch+(_x) shl 1))=(colour)
    #define onscreen ((x1)>=0) And ((x1)<(sd.w-1)) And ((y1)>=0) And ((y1)<(sd.h-1))
    Var dx=Abs(x2-x1),dy=Abs(y2-y1),sx=Sgn(x2-x1),sy=Sgn(y2-y1)
    dim as long e
    If dx<dy Then  e=dx\2 Else e=dy\2
    Do
                If onscreen Then
                    If sd.depth=8  Then ppset8((x1),(y1),col)
                    If sd.depth=16 Then ppset16((x1),(y1),col)
                    If sd.depth=32 Then ppset32((x1),(y1),col)
                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

Screen 20,32  '''''''' try 8

Dim As screendata S

With S
    Screeninfo .w,.h,.depth,,.pitch
    .row=Screenptr
End With

windowtitle str(S.depth) + "   bits"

dim as double t=timer
screenlock
for n as long=0 to 768
    if S.depth=8 then bline(S,0,n,1024-n,n,5)
    if S.depth>8 then bline(S,0,n,1024-n,n,rgb(200,n\3 ,0))
next
    screenunlock
    locate 29,85
    
    print timer-t;"  seconds"
    
    'prepare for paint with the sloped line
    if S.depth>8 then line(1024,0)-(1024-768,768),rgb(255,255,255)
    if S.depth=8 then line(1024,0)-(1024-768,768),15 
    locate 30,85
    print "Press a key
sleep
    
    t=timer
    screenlock
   if S.depth >8 then paint(0,0),rgb(200,0,0),rgb(255,255,255)
   if S.depth = 8 then paint(0,0),4,15
   screenunlock
   locate 32,85
    print timer-t;"  seconds"
    sleep




 
If anybody knows how to get the 64 bit compiler up to speed with the 32 bit one, please post the solution.
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: Writing to screenbuffer

Post by srvaldez »

hello dodicat
compile with sse
fbc -w all "%f" -asm intel -fpu sse -gen gcc -Wc -O2
though the times vary from run to run, I suspect that the time interval is too short for accurate timing.
Post Reply