FreeBasic+OpenGL. Help

New to FreeBASIC? Post your questions here.
PavelUT
Posts: 78
Joined: Jun 14, 2021 14:42

FreeBasic+OpenGL. Help

Post by PavelUT »

Hello. I wrote a simple FreeBasic + OpenGL program. 2 sprites are displayed on the screen. The "Grass" is 400x400 pixels and the boy's
moving sprite is 112x180 pixels. Since this is my 1 program with OpenGL, please tell me if I did everything correctly and can I improve something?
I will be very grateful

Code: Select all

'Redesigned for 2D sprite 07/03/21
'make transparency

#include once "fbgfx.bi"
Using FB
#include "GL/gl.bi"
#include "GL/glu.bi"

Dim Shared As Gluint texture (2) 'array and 2 texture IDs

Const scrnX = 800 '1024
Const scrnY = 600 '768
Const depth = 32
Const fullscreen = &h0  'Full screen mode (& h0 = normal, & h1 = full screen)
Screenres scrnX, scrnY, depth ,, &h2 Or fullscreen, GFX_MULTISAMPLE

Screeninfo scrnX, scrnY
Windowtitle "OpenGL 2D Sprite"
Dim As short xscr = 20, yscr = 100 'start coordinates of yellow rectangle

Dim As Integer spr_sizeX = 112, spr_sizeY = 180 'sprite size
Dim As Integer fon_sizeX = 400, fon_sizeY = 400 'background sizes

Sub setupgl
'OpenGL configuration
glMatrixMode (GL_PROJECTION) 'Matrix definition
glLoadIdentity
glViewport (0,0, scrnX, scrnY) 'Set the coordinate axis
glOrtho (0, scrnX, scrnY, 0, -128,128)
glMatrixMode (GL_MODELVIEW) 'Disable rendering of invisible parts
glShadeModel (GL_FLAT)
glEnable (GL_SMOOTH)
glCullFace (GL_BACK)
glEnable GL_TEXTURE_2D 'Enable textures
glLoadIdentity
glEnable (GL_DEPTH_TEST) 'Depth Test
glDepthFunc (GL_LESS)
glEnable (GL_ALPHA_TEST) 'Test Alpha
glAlphaFunc (GL_GREATER, 0.1)
End Sub

Dim As Byte Ptr img_fon
Dim As Byte Ptr img

img_fon = ImageCreate (fon_sizeX, fon_sizeY, RGBA (255, 100, 100, 128), 32)
img = ImageCreate (spr_sizeX, spr_sizeY, RGBA (255, 255, 255, 128), 32) 'Image bilden

'' loading sprite background 400x400
Bload ("texttrava123.bmp", img_fon)
glGenTextures (1, @texture (0))
glBindTexture GL_TEXTURE_2D, texture (0)
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT)
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT)
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR 'this is required!
glTexImage2D GL_TEXTURE_2D, 0, GL_RGBA, fon_sizeX, fon_sizeY, 0, GL_BGRA, GL_UNSIGNED_BYTE, img_fon +32
ImageDestroy img_fon 'Pixel data is received, memory is freed

'' loading sprite boy 112x180
Bload ("gars112_180_1.bmp", img)
glGenTextures (2, @texture (1))
glBindTexture (GL_TEXTURE_2D, texture (1)) 'texture binding
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT)
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT)
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR 'this is required!
glTexImage2D GL_TEXTURE_2D, 0, GL_RGBA, spr_sizeX, spr_sizeY, 0, GL_BGRA, GL_UNSIGNED_BYTE, img +32
ImageDestroy img 'Pixel data is received, memory is freed

sub spr_surf_fon (xscr as short, yscr as short, zscr as short, fon_sizeX as short, fon_sizeY as short)
 ' the background

 glTranslatef 0,0, -1 'z = -1 location coordinates x, y, z
 GlBindTexture (GL_TEXTURE_2D, texture (0))
 glBegin GL_QUADS
 glColor4ub 255,255,255,255 'set the white color of the rectangle Rd, Gd, Bd, Ad)
 glTexCoord2f 0, 1 'binds texture coordinates to object vertices.
 glVertex2i 0, fon_sizeY '' Bottom left (1st coordinate)
 glTexCoord2f 1, 1
 glVertex2i fon_sizeX, fon_sizeY '' Bottom right (2.coordinate)
 glTexCoord2f 1,0
 glVertex2i fon_sizeX, 0 '' Top right (3.coordinate)
 glTexCoord2f 0, 0
 glVertex2i 0, 0 '' Top left (4th coordinate)
 glEnd
 
  glLoadIdentity
   end sub


sub spr_surf (xscr as short, yscr as short, zscr as short, xspr_size as short, yspr_size as short)

 glTranslatef xscr, 300,2 'z = 2 location coordinates x, y, z
 GlBindTexture GL_TEXTURE_2D, texture (1)
 glBegin GL_QUADS
 glColor4ub 255,255,255,255 'set the white color of the rectangle Rd, Gd, Bd, Ad)
 glTexCoord2f 0, 1 'binds texture coordinates to object vertices.
 glVertex2i 0, yspr_size '' Bottom left (1st coordinate)
 glTexCoord2f 1, 1
 glVertex2i xspr_size, yspr_size '' Bottom right (2.coordinate)
 glTexCoord2f 1, 0
 glVertex2i xspr_size, 0 '' Top right (3.coordinate)
 glTexCoord2f 0, 0
 glVertex2i 0, 0 '' Top left (4th coordinate)
 glEnd

  glLoadIdentity
   end sub
   
  setupgl

Do
 glClearColor (0.5f, 0.7f, 0.5f, 1.0f) 'setting the background color
 glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT 'clear the background

  '' reset coordinates
  GLLoadIdentity ()
  spr_surf_fon (xscr, yscr, 0, fon_sizeX, fon_sizeY) 'display background 400x400

  spr_surf (xscr, yscr, 0, spr_sizeX, spr_sizeY) 'display the sprite 112x180
 '
 '!! there are different teams here !!
  xscr + = 2: If (xscr> 720) Then xscr = 0 'sprite movement
 
  GLLoadIdentity ()
  
  'Square B
 glTranslatef 150,200,1 'z = 1
 glBegin GL_QUADS
 glColor4ub 0,0,255,200 'blue square
 glTexCoord2f 0, 0
 glVertex2i 0, 100 '' Bottom left (1st coordinate)
 glTexCoord2f 1, 0
 glVertex2i 100, 100 '' Bottom right (2nd coordinate)
 glTexCoord2f 1, 1
 glVertex2i 100, 0 '' Top right (3rd coordinate)
  glTexCoord2f 0, 1
 glVertex2i 0, 0 '' Top left (4th coordinate)
 glEnd
 glLoadIdentity
 
  
  glFlush 'Command Handling
  Flip 'switching screens

  glBindTexture GL_TEXTURE_2D, 0 'Free texture

Loop While Inkey$ = ""
End 
caseih
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: FreeBasic+OpenGL. Help

Post by caseih »

Looks good to me, although I don't have any of the bitmaps. And I know very little about OpenGL. But it draws and animates pretty smoothly.

Does this run good on a Pi? The reason I ask is because I'm pretty sure the Pi only has hardware acceleration support for OpenGL ES, which requires shader scripts. I've only dabbled in OpenGL ES and shaders, and not in FB.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: FreeBasic+OpenGL. Help

Post by paul doe »

PavelUT wrote:...
Since this is my 1 program with OpenGL, please tell me if I did everything correctly and can I improve something?
...
We can't test it as intended, of course, because we don't have the bitmaps required. Also, it won't compile in fbc 1.08 without including the glext headers (since GL_BGRA is defined there):

Code: Select all

#include "GL/gl.bi"
#include "GL/glu.bi"
#include once "GL/glext.bi"
As for improvements, you could try writing a generic function that draws a sprite, instead of one for each sprite. Same for loading textures:

Code: Select all

'' Loads a BMP into an OpenGL texture
function loadTexture( path as string ) as GLuint
  #define __BM_WINDOWS__ &h4D42
  
  type __BITMAPFILEHEADER__ field = 1
    as ushort id
    as ulong size
    as ubyte reserved( 0 to 3 )
    as ulong offset
  end type
  
  type __BITMAPINFOHEADER__ field = 1
    as ulong size
    as long width
    as long height
    as ushort planes
    as ushort bpp
    as ulong compression_method
    as ulong image_size
    as ulong h_res
    as ulong v_res
    as ulong color_palette_num
    as ulong colors_used
  end type
  
  dim as Fb.Image ptr img = 0
  dim as GLuint texture = 0
  
  if( fileExists( path ) ) then
    dim as __BITMAPFILEHEADER__ header 
    dim as __BITMAPINFOHEADER__ info
    
    dim as long f = freeFile()
    
    open path for binary as f
      get #f, , header
      get #f, sizeof( header ) + 1, info
    close( f )
    
    '' Check if the file is indeed a Windows bitmap
    if( header.id = __BM_WINDOWS__ ) then
      img = imageCreate( info.width, info.height )
      bload( path, img )
      
      glGenTextures( 1, @texture )
      glBindTexture( GL_TEXTURE_2D, texture )
      
      /'
        ** IMPORTANT **
        These two calls are needed to tell OpenGL about the _alignment_ of the FB buffers,
        since image buffers are aligned to a paragraph (16 bytes) boundary and may have
        padding pixels at the end of each scanline.
      '/
      glPixelStorei( GL_UNPACK_ALIGNMENT, 4 )
      glPixelStorei( GL_UNPACK_ROW_LENGTH, img->pitch \ sizeof( ulong ) )
      
      glTexImage2D( GL_TEXTURE_2D, 0, _
        GL_RGBA, img->width, img->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, _
        cast( ulong ptr, img ) + sizeof( Fb.Image ) \ sizeof( ulong ) )
      
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE )
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE )
      
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR )
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR )
      
      '' we're finished so unbind the texture
      glBindTexture( GL_TEXTURE_2D, 0 )
      imageDestroy( img )
    end if
  end if
  
  return( texture )
end function
EDIT: I just noticed that you didn't take alignment of the FB image buffers into account, and modified the loadTexture() function accordingly. Check the note inside the function to see how this is done in OpenGL, and why you need to do it when working with Fb.Image buffers.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBasic+OpenGL. Help

Post by dodicat »

I have touched up my original a little.
BUG?? the refreshrate is wrong from opengl screen screeninfo !!

Code: Select all


#include "GL/gl.bi"
#include "GL/glext.bi"
#include "fbgfx.bi"
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Screenres 800,600,32
Dim As long refreshrate
Dim As String driver
Screeninfo ,,,,,refreshrate'BUG??  refreshrate wrong on opengl screen

Screenres 800, 600, 32,,2 
Screeninfo ,,,,,,driver
Width 800\8,600\16 'full fonts on image

  #ifdef __FB_WIN32__
Declare Function settimer       Alias "timeBeginPeriod"(As Ulong=1) As Long
Declare Function freetimer      Alias "timeEndPeriod"  (As Ulong=1) As Long
#endif

type point
      as long x,y
      end type

Sub setupgl
    Dim As Integer xres,yres
    Screeninfo xres,yres
    glDisable (GL_DEPTH_TEST)
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    'glBlendFunc(GL_SRC_COLOR, GL_ONE_MINUS_SRC_COLOR)
    glEnable (GL_BLEND)
    glEnable (GL_LINE_SMOOTH)
    glOrtho 0, xres, yres,0,-1, 1
End Sub

setupgl

Sub drawstring(xpos As Long,ypos As Long,text As String ,col As Ulong,size As Single,xres As Long,yres As Long) Export
    glMatrixMode GL_PROJECTION 'save projection
    glPushMatrix
    glMatrixMode GL_MODELVIEW
    glPushMatrix
    
    glMatrixMode GL_PROJECTION 'make ortho
    glLoadIdentity
    glOrtho 0, xres, yres, 0,-1, 1
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    #define Red(c) ((c) Shr 16 And 255)
    #define Green(c) ((c) Shr  8 And 255)
    #define Blue(c) ((c) And 255)
    #define Alph(c) ((c) Shr 24)
    glColor4ub Red(col),Green(col),Blue(col),alph(col)
    glend
    glpointsize(1.1*size)
    glBegin (GL_POINTS)
    Type D2
        As Single x,y
    End Type
    Static As d2 cpt(),XY()
    Static As Long runflag
    If runflag=0 Then   
        Redim  XY(128,127)
        Redim cpt(1 To 64*2)
        Screen 8
        Width 640\8,200\16
        Dim As Ulong Pointer img
        Dim count As Long
        For ch As Long=1 To 127
            img=Imagecreate(640,200)
            Draw String img,(1,1),Chr(ch)
            For x As Long=1 To 8 
                For y As Long=1 To 16
                    If Point(x,y,img)<>0 Then
                        count=count+1
                        XY(count,ch)=Type<D2>(x,y)
                    End If
                Next y
            Next x
            count=0
            Imagedestroy img
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As D2 np,t
    #macro Scale(p1,p2,d)
    np.x=d*(p2.x-p1.x)+p1.x
    np.y=d*(p2.y-p1.y)+p1.y
    #endmacro
    
    Dim As D2 c=Type<D2>(xpos,ypos)
    Dim As Long dx=xpos,dy=ypos
    For z6 As Long=1 To Len(text)
        Var asci=text[z6-1]
        For _x1 As Long=1 To 64*2
            t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy)         
            Scale(c,t,size)
            cpt(_x1)=np
            
            If XY(_x1,asci).x<>0 Then
                If Abs(size)>0 Then
                    glVertex3f (cpt(_x1).x,(cpt(_x1).y),0)
                End If
            End If
        Next _x1
        dx=dx+8
    Next z6
    glend
    glMatrixMode GL_PROJECTION 'restore 
    glPopMatrix
    glMatrixMode GL_MODELVIEW
    glPopMatrix
End Sub

Sub inittext Constructor
    drawstring(0,0,"",0,0,0,0)
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

Sub settexture(byref texture As gluint, image As Any Ptr)
    glGenTextures(1, @texture)
    glBindTexture( GL_TEXTURE_2D, texture )
    glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )   
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
    glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
End Sub

Sub drawquad(p1 as point,p2 as point,p3 as point,p4 as point)
      'start at top right, go anti-clockwise
    glBegin(GL_QUADS)
    glTexCoord2f( 1,0 )
    glVertex2f( p1.x, p1.y)            'Top right of the quad
    glTexCoord2f( 0,0 )
    glVertex2f(p2.x,p2.y)          'Top left of the quad
    glTexCoord2f( 0,1 )
    glVertex2f(p3.x,p3.y)      ' Bottom left of the quad
    glTexCoord2f( 1,1 )
    glVertex2f( p4.x,p4.y)        ' Bottom right of the quad
    glend
End Sub


Dim As Any Ptr im=Imagecreate(128/2,128),back=imagecreate(800,600),other=imagecreate(200,200,rgb(0,100,255))
'======== draw stuff to images ===========
For x As Long=0 To 128\2
    For y As Long=0 To 128
        Pset im,(x,y),Rgb(x*4,x*4 xor y*4,y*4)
    Next y
Next x
Circle im,(32,64),20,Rgb(200,0,0),,,,f

For n As Long=0 To 600
        Var red=map(0,600,n,0,255)
        Var green=map(0,600,n,0,255)
        Var blue=map(0,600,n,100,255)
        Line back,(0,n)-(1024,n),Rgb(red,green,blue)
    Next
    Circle back,(512,10000),10000-410,Rgb(0,100,0),,,,f
    
Draw String im,(10,100),"Hello",Rgb(255,255,255)

circle other,(100,100),50,0
draw string other,(20,20),"Find me a bitmap"
'=======================================

Dim As gluint tex1,tex2,tex3
settexture(tex1,im)
settexture(tex2,back)
settexture(tex3,other)

Dim As Integer x = 0
Dim As Long fps,dx=200,dy=208


Do
    glClear(GL_COLOR_BUFFER_BIT)
   
    glEnable( GL_TEXTURE_2D )
    glBindTexture(GL_TEXTURE_2D,tex2)'back
    drawquad(type(800,0),type(0,0),type(0,600),type(800,600))
    
    
    glBindTexture(GL_TEXTURE_2D, tex1)'moving box
    drawquad(type(x,80),type(x-63,80),type(x-63, 127+80),type( x, 127+80))
    
    glBindTexture(GL_TEXTURE_2D, tex3)'still box
     drawquad(type(200+dx,0+dy),type(0+dx,0+dy),type(0+dx,200+dy),type(200+dx,200+dy))
     
    gldisable( GL_TEXTURE_2D ) 'to get drawstring colours

    x += 1: If (x > 639) Then x = 0
    drawstring(20,20,"framerate = " &fps,Rgb(0,200,0),1,800,600)
    drawstring(20,40,"refreshrate = " &refreshrate,Rgb(0,200,0),1,800,600)
    drawstring(20,60,"driver = " +driver,Rgb(200,200,0),1,800,600)
    Flip
    
    #ifdef __FB_WIN32__
    settimer
    Sleep regulate(refreshrate*3,fps)
    freetimer
    #else
    Sleep regulate(refreshrate*3,fps)
    #endif
Loop While Inkey = ""
Imagedestroy im
imagedestroy  back
imagedestroy other

End
 
freebasic 1.08.0
PavelUT
Posts: 78
Joined: Jun 14, 2021 14:42

Re: FreeBasic+OpenGL. Help

Post by PavelUT »

caseih wrote:Looks good to me, although I don't have any of the bitmaps. And I know very little about OpenGL. But it draws and animates pretty smoothly.

Does this run good on a Pi? The reason I ask is because I'm pretty sure the Pi only has hardware acceleration support for OpenGL ES, which requires shader scripts. I've only dabbled in OpenGL ES and shaders, and not in FB.
You can take any suitable bitmaps. The irony is that animation in Raspberry is also distorted even with OpenGl (like in my program). Maybe a defective computer got caught?
PavelUT
Posts: 78
Joined: Jun 14, 2021 14:42

Re: FreeBasic+OpenGL. Help

Post by PavelUT »

dodicat wrote:I have touched up my original a little.
BUG?? the refreshrate is wrong from opengl screen screeninfo !!

Code: Select all


#include "GL/gl.bi"
#include "GL/glext.bi"
#include "fbgfx.bi"
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Screenres 800,600,32
Dim As long refreshrate
Dim As String driver
Screeninfo ,,,,,refreshrate'BUG??  refreshrate wrong on opengl screen

Screenres 800, 600, 32,,2 
Screeninfo ,,,,,,driver
Width 800\8,600\16 'full fonts on image

  #ifdef __FB_WIN32__
Declare Function settimer       Alias "timeBeginPeriod"(As Ulong=1) As Long
Declare Function freetimer      Alias "timeEndPeriod"  (As Ulong=1) As Long
#endif

type point
      as long x,y
      end type

Sub setupgl
    Dim As Integer xres,yres
    Screeninfo xres,yres
    glDisable (GL_DEPTH_TEST)
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    'glBlendFunc(GL_SRC_COLOR, GL_ONE_MINUS_SRC_COLOR)
    glEnable (GL_BLEND)
    glEnable (GL_LINE_SMOOTH)
    glOrtho 0, xres, yres,0,-1, 1
End Sub

setupgl

Sub drawstring(xpos As Long,ypos As Long,text As String ,col As Ulong,size As Single,xres As Long,yres As Long) Export
    glMatrixMode GL_PROJECTION 'save projection
    glPushMatrix
    glMatrixMode GL_MODELVIEW
    glPushMatrix
    
    glMatrixMode GL_PROJECTION 'make ortho
    glLoadIdentity
    glOrtho 0, xres, yres, 0,-1, 1
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    #define Red(c) ((c) Shr 16 And 255)
    #define Green(c) ((c) Shr  8 And 255)
    #define Blue(c) ((c) And 255)
    #define Alph(c) ((c) Shr 24)
    glColor4ub Red(col),Green(col),Blue(col),alph(col)
    glend
    glpointsize(1.1*size)
    glBegin (GL_POINTS)
    Type D2
        As Single x,y
    End Type
    Static As d2 cpt(),XY()
    Static As Long runflag
    If runflag=0 Then   
        Redim  XY(128,127)
        Redim cpt(1 To 64*2)
        Screen 8
        Width 640\8,200\16
        Dim As Ulong Pointer img
        Dim count As Long
        For ch As Long=1 To 127
            img=Imagecreate(640,200)
            Draw String img,(1,1),Chr(ch)
            For x As Long=1 To 8 
                For y As Long=1 To 16
                    If Point(x,y,img)<>0 Then
                        count=count+1
                        XY(count,ch)=Type<D2>(x,y)
                    End If
                Next y
            Next x
            count=0
            Imagedestroy img
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As D2 np,t
    #macro Scale(p1,p2,d)
    np.x=d*(p2.x-p1.x)+p1.x
    np.y=d*(p2.y-p1.y)+p1.y
    #endmacro
    
    Dim As D2 c=Type<D2>(xpos,ypos)
    Dim As Long dx=xpos,dy=ypos
    For z6 As Long=1 To Len(text)
        Var asci=text[z6-1]
        For _x1 As Long=1 To 64*2
            t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy)         
            Scale(c,t,size)
            cpt(_x1)=np
            
            If XY(_x1,asci).x<>0 Then
                If Abs(size)>0 Then
                    glVertex3f (cpt(_x1).x,(cpt(_x1).y),0)
                End If
            End If
        Next _x1
        dx=dx+8
    Next z6
    glend
    glMatrixMode GL_PROJECTION 'restore 
    glPopMatrix
    glMatrixMode GL_MODELVIEW
    glPopMatrix
End Sub

Sub inittext Constructor
    drawstring(0,0,"",0,0,0,0)
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

Sub settexture(byref texture As gluint, image As Any Ptr)
    glGenTextures(1, @texture)
    glBindTexture( GL_TEXTURE_2D, texture )
    glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )   
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
    glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
End Sub

Sub drawquad(p1 as point,p2 as point,p3 as point,p4 as point)
      'start at top right, go anti-clockwise
    glBegin(GL_QUADS)
    glTexCoord2f( 1,0 )
    glVertex2f( p1.x, p1.y)            'Top right of the quad
    glTexCoord2f( 0,0 )
    glVertex2f(p2.x,p2.y)          'Top left of the quad
    glTexCoord2f( 0,1 )
    glVertex2f(p3.x,p3.y)      ' Bottom left of the quad
    glTexCoord2f( 1,1 )
    glVertex2f( p4.x,p4.y)        ' Bottom right of the quad
    glend
End Sub


Dim As Any Ptr im=Imagecreate(128/2,128),back=imagecreate(800,600),other=imagecreate(200,200,rgb(0,100,255))
'======== draw stuff to images ===========
For x As Long=0 To 128\2
    For y As Long=0 To 128
        Pset im,(x,y),Rgb(x*4,x*4 xor y*4,y*4)
    Next y
Next x
Circle im,(32,64),20,Rgb(200,0,0),,,,f

For n As Long=0 To 600
        Var red=map(0,600,n,0,255)
        Var green=map(0,600,n,0,255)
        Var blue=map(0,600,n,100,255)
        Line back,(0,n)-(1024,n),Rgb(red,green,blue)
    Next
    Circle back,(512,10000),10000-410,Rgb(0,100,0),,,,f
    
Draw String im,(10,100),"Hello",Rgb(255,255,255)

circle other,(100,100),50,0
draw string other,(20,20),"Find me a bitmap"
'=======================================

Dim As gluint tex1,tex2,tex3
settexture(tex1,im)
settexture(tex2,back)
settexture(tex3,other)

Dim As Integer x = 0
Dim As Long fps,dx=200,dy=208


Do
    glClear(GL_COLOR_BUFFER_BIT)
   
    glEnable( GL_TEXTURE_2D )
    glBindTexture(GL_TEXTURE_2D,tex2)'back
    drawquad(type(800,0),type(0,0),type(0,600),type(800,600))
    
    
    glBindTexture(GL_TEXTURE_2D, tex1)'moving box
    drawquad(type(x,80),type(x-63,80),type(x-63, 127+80),type( x, 127+80))
    
    glBindTexture(GL_TEXTURE_2D, tex3)'still box
     drawquad(type(200+dx,0+dy),type(0+dx,0+dy),type(0+dx,200+dy),type(200+dx,200+dy))
     
    gldisable( GL_TEXTURE_2D ) 'to get drawstring colours

    x += 1: If (x > 639) Then x = 0
    drawstring(20,20,"framerate = " &fps,Rgb(0,200,0),1,800,600)
    drawstring(20,40,"refreshrate = " &refreshrate,Rgb(0,200,0),1,800,600)
    drawstring(20,60,"driver = " +driver,Rgb(200,200,0),1,800,600)
    Flip
    
    #ifdef __FB_WIN32__
    settimer
    Sleep regulate(refreshrate*3,fps)
    freetimer
    #else
    Sleep regulate(refreshrate*3,fps)
    #endif
Loop While Inkey = ""
Imagedestroy im
imagedestroy  back
imagedestroy other

End
 
freebasic 1.08.0
Thank you very much for your attention to my problems. I want to say that your program has no distortion when the rectangle moves, even at a speed of +3. Can you tell me what this is connected with? What is the fundamental difference in the code? Is it due to software time delay?
freebasic 1.07.
PavelUT
Posts: 78
Joined: Jun 14, 2021 14:42

Re: FreeBasic+OpenGL. Help

Post by PavelUT »

paul doe wrote:
PavelUT wrote:...
Since this is my 1 program with OpenGL, please tell me if I did everything correctly and can I improve something?
...
We can't test it as intended, of course, because we don't have the bitmaps required. Also, it won't compile in fbc 1.08 without including the glext headers (since GL_BGRA is defined there):

Code: Select all

#include "GL/gl.bi"
#include "GL/glu.bi"
#include once "GL/glext.bi"
As for improvements, you could try writing a generic function that draws a sprite, instead of one for each sprite. Same for loading textures:

Code: Select all

'' Loads a BMP into an OpenGL texture
function loadTexture( path as string ) as GLuint
  #define __BM_WINDOWS__ &h4D42
  
  type __BITMAPFILEHEADER__ field = 1
    as ushort id
    as ulong size
    as ubyte reserved( 0 to 3 )
    as ulong offset
  end type
  
  type __BITMAPINFOHEADER__ field = 1
    as ulong size
    as long width
    as long height
    as ushort planes
    as ushort bpp
    as ulong compression_method
    as ulong image_size
    as ulong h_res
    as ulong v_res
    as ulong color_palette_num
    as ulong colors_used
  end type
  
  dim as Fb.Image ptr img = 0
  dim as GLuint texture = 0
  
  if( fileExists( path ) ) then
    dim as __BITMAPFILEHEADER__ header 
    dim as __BITMAPINFOHEADER__ info
    
    dim as long f = freeFile()
    
    open path for binary as f
      get #f, , header
      get #f, sizeof( header ) + 1, info
    close( f )
    
    '' Check if the file is indeed a Windows bitmap
    if( header.id = __BM_WINDOWS__ ) then
      img = imageCreate( info.width, info.height )
      bload( path, img )
      
      glGenTextures( 1, @texture )
      glBindTexture( GL_TEXTURE_2D, texture )
      
      /'
        ** IMPORTANT **
        These two calls are needed to tell OpenGL about the _alignment_ of the FB buffers,
        since image buffers are aligned to a paragraph (16 bytes) boundary and may have
        padding pixels at the end of each scanline.
      '/
      glPixelStorei( GL_UNPACK_ALIGNMENT, 4 )
      glPixelStorei( GL_UNPACK_ROW_LENGTH, img->pitch \ sizeof( ulong ) )
      
      glTexImage2D( GL_TEXTURE_2D, 0, _
        GL_RGBA, img->width, img->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, _
        cast( ulong ptr, img ) + sizeof( Fb.Image ) \ sizeof( ulong ) )
      
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE )
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE )
      
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR )
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR )
      
      '' we're finished so unbind the texture
      glBindTexture( GL_TEXTURE_2D, 0 )
      imageDestroy( img )
    end if
  end if
  
  return( texture )
end function
EDIT: I just noticed that you didn't take alignment of the FB image buffers into account, and modified the loadTexture() function accordingly. Check the note inside the function to see how this is done in OpenGL, and why you need to do it when working with Fb.Image buffers.
About textures. If it doesn't bother you, try using any of the ones you have.
I know the need to align the buffer, but so the length of the sprites is a multiple of 4, (only) for this case it does not matter.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBasic+OpenGL. Help

Post by dodicat »

I use 1.08.0, but there are known bugs, so maybe 1.07 is OK.
I am unsure why it is smoother than gfx, I only have win 10 to test.
Here, for fun, is an added complication.
Still runs smoothly here.

Code: Select all

#include "GL/gl.bi"
#include "GL/glext.bi"
#include "gl/glu.bi"
#include "fbgfx.bi"
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Screenres 800,600,32
Dim As Long refreshrate
Dim As String driver
Screeninfo ,,,,,refreshrate'BUG??  refreshrate wrong on opengl screen

Screenres 800, 600, 32,,2
Screeninfo ,,,,,,driver
Width 800\8,600\16 'full fonts on image

#ifdef __fb_win32__
Declare Function settimer       Alias "timeBeginPeriod"(As Ulong=1) As Long
Declare Function freetimer      Alias "timeEndPeriod"  (As Ulong=1) As Long
#endif

Type Point
      As Long x,y
End Type
Sub setupgl 
      Dim As Integer xres,yres
      Screeninfo xres,yres
      glShadeModel(GL_SMOOTH)                 ' Enables Smooth Color Shading
      glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST) 
      glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
      glEnable GL_ALPHA
      glEnable GL_BLEND
      glViewport(0, 0, xres, yres)       ' Set the viewport
      glMatrixMode(GL_PROJECTION)        ' Change Matrix Mode to Projection
      glLoadIdentity                     ' Reset View
      gluPerspective(45.0, xres/yres, 1.0, 100.0) 
      glMatrixMode(GL_MODELVIEW)         ' Return to the modelview matrix
      glLoadIdentity                     '  Reset View
      glclearcolor 1,.5,0,1
End Sub


Sub saveprojection
      glMatrixMode GL_PROJECTION 'save projection
      glPushMatrix
      glMatrixMode GL_MODELVIEW
      glPushMatrix
End Sub

Sub makeortho
      Dim As Long xres,yres
      Screeninfo xres,yres
      glMatrixMode GL_PROJECTION 'make ortho
      glLoadIdentity
      glOrtho 0, xres, yres, 0,-1, 1
      glMatrixMode GL_MODELVIEW
      glLoadIdentity
End Sub

Sub restoreprojection
      glMatrixMode GL_PROJECTION 'restore
      glPopMatrix
      glMatrixMode GL_MODELVIEW
      glPopMatrix 
End Sub


Sub drawstring(xpos As Long,ypos As Long,text As String ,col As Ulong,size As Single,xres As Long,yres As Long) Export
      glMatrixMode GL_PROJECTION 'save projection
      glPushMatrix
      glMatrixMode GL_MODELVIEW
      glPushMatrix
      
      glMatrixMode GL_PROJECTION 'make ortho
      glLoadIdentity
      glOrtho 0, xres, yres, 0,-1, 1
      glMatrixMode GL_MODELVIEW
      glLoadIdentity
      #define Red(c) ((c) Shr 16 And 255)
      #define Green(c) ((c) Shr  8 And 255)
      #define Blue(c) ((c) And 255)
      #define Alph(c) ((c) Shr 24)
      glColor4ub Red(col),Green(col),Blue(col),alph(col)
      glend
      glpointsize(1.1*size)
      glBegin (GL_POINTS)
      Type D2
            As Single x,y
      End Type
      Static As d2 cpt(),XY()
      Static As Long runflag
      If runflag=0 Then   
            Redim  XY(128,127)
            Redim cpt(1 To 64*2)
            Screen 8
            Width 640\8,200\16
            Dim As Ulong Pointer img
            Dim count As Long
            For ch As Long=1 To 127
                  img=Imagecreate(640,200)
                  Draw String img,(1,1),Chr(ch)
                  For x As Long=1 To 8
                        For y As Long=1 To 16
                              If Point(x,y,img)<>0 Then
                                    count=count+1
                                    XY(count,ch)=Type<D2>(x,y)
                              End If
                        Next y
                  Next x
                  count=0
                  Imagedestroy img
            Next ch
            runflag=1
      End If
      If size=0 Then Exit Sub
      Dim As D2 np,t
      #macro Scale(p1,p2,d)
      np.x=d*(p2.x-p1.x)+p1.x
      np.y=d*(p2.y-p1.y)+p1.y
      #endmacro
      
      Dim As D2 c=Type<D2>(xpos,ypos)
      Dim As Long dx=xpos,dy=ypos
      For z6 As Long=1 To Len(text)
            Var asci=text[z6-1]
            For _x1 As Long=1 To 64*2
                  t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy)         
                  Scale(c,t,size)
                  cpt(_x1)=np
                  
                  If XY(_x1,asci).x<>0 Then
                        If Abs(size)>0 Then
                              glVertex3f (cpt(_x1).x,(cpt(_x1).y),0)
                        End If
                  End If
            Next _x1
            dx=dx+8
      Next z6
      glend
      glMatrixMode GL_PROJECTION 'restore
      glPopMatrix
      glMatrixMode GL_MODELVIEW
      glPopMatrix
End Sub

Sub inittext Constructor
      drawstring(0,0,"",0,0,0,0)
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
      Static As Double timervalue,lastsleeptime,t3,frames
      frames+=1
      If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
      Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
      If sleeptime<1 Then sleeptime=1
      lastsleeptime=sleeptime
      timervalue=Timer
      Return sleeptime
End Function

Sub settexture(Byref texture As gluint, image As Any Ptr)
      glGenTextures(1, @texture)
      glBindTexture( GL_TEXTURE_2D, texture )
      glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )   
      glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
      glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
      glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
End Sub

Sub drawquad(p1 As Point,p2 As Point,p3 As Point,p4 As Point)
      'start at top right, go anti-clockwise
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex2f( p1.x, p1.y)            'Top right of the quad
      glTexCoord2f( 0,0 )
      glVertex2f(p2.x,p2.y)          'Top left of the quad
      glTexCoord2f( 0,1 )
      glVertex2f(p3.x,p3.y)      ' Bottom left of the quad
      glTexCoord2f( 1,1 )
      glVertex2f( p4.x,p4.y)        ' Bottom right of the quad
      glend
End Sub

Sub DrawGlCube(Byref rotangle As Single,f() As gluint)
      glLoadIdentity()
      glTranslatef(1,0,-10)
      glRotatef(rotangle,1,.5,.25)           ' Rotate 
      glBindTexture(GL_TEXTURE_2D,f(1))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top right of the quad (top)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top left of the quad (top)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Bottom left of the quad (top)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Bottom right of the quad (top)
      glend
      glBindTexture(GL_TEXTURE_2D,f(6))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )       
      glVertex3f( 1.0,-1.0, 1.0)            ' Top right of the quad (bottom)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Top left of the quad (bottom)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom left of the quad (bottom)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0,-1.0,-1.0)            ' Bottom right of the quad (bottom)
      glend
      glBindTexture(GL_TEXTURE_2D,f(2))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Top right of the quad (front)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Top left of the quad (front)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Bottom left of the quad (front)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0,-1.0, 1.0)            ' Bottom right of the quad (front)
      glend
      glBindTexture(GL_TEXTURE_2D,f(5))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0,-1.0,-1.0)            ' Bottom left of the quad (back)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom right of the quad (back)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top right of the quad (back)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top left of the quad (back)
      glend
      glBindTexture(GL_TEXTURE_2D,f(3))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Top right of the quad (left)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top left of the quad (left)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom left of the quad (left)
      glTexCoord2f( 1,1 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Bottom right of the quad (left)
      glend
      glBindTexture(GL_TEXTURE_2D,f(4))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top right of the quad (right)
      glTexCoord2f( 0,0 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Top left of the quad (right)
      glTexCoord2f( 0,1 )
      glVertex3f( 1.0,-1.0, 1.0)            ' Bottom left of the quad (right)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0,-1.0,-1.0)
      glend
End Sub
Sub setdice(i() As Any Ptr,size As Long,facecol As Ulong=Rgb(200,200,0),dotcol As Ulong=Rgb(0,0,0)) 'create images
      Type v
            As Long x,y
      End Type
      Dim As v p(1 To 7)
      Redim i(1 To 6)
      Dim As Long sz=size,dt=sz/12
      p(1)=Type(sz/4,sz/4)
      p(2)=Type(sz/4,sz/2)
      p(3)=Type(sz/4,3*sz/4)
      p(4)=Type(3*sz/4,sz/4)
      p(5)=Type(3*sz/4,sz/2)
      p(6)=Type(3*sz/4,3*sz/4)
      p(7)=Type(sz/2,sz/2)
      
      For n As Long=1 To 6
            i(n)=Imagecreate(sz,sz,facecol)
            
            Line i(n),(0,0)-(sz-1,sz-1),dotcol,b
            Draw String i(1),(5,5),"Text size test",Rgb(0,0,200)
            Select Case n
            Case 1
                  Circle i(1),(p(7).x,p(7).y),dt,dotcol,,,,f
            Case 2
                  Circle i(2),(p(1).x,p(1).y),dt,dotcol,,,,f
                  Circle i(2),(p(6).x,p(6).y),dt,dotcol,,,,f
            Case 3
                  Circle i(3),(p(1).x,p(1).y),dt,dotcol,,,,f
                  Circle i(3),(p(7).x,p(7).y),dt,dotcol,,,,f
                  Circle i(3),(p(6).x,p(6).y),dt,dotcol,,,,f
            Case 4
                  Circle i(4),(p(1).x,p(1).y),dt,dotcol,,,,f 
                  Circle i(4),(p(3).x,p(3).y),dt,dotcol,,,,f 
                  Circle i(4),(p(4).x,p(4).y),dt,dotcol,,,,f 
                  Circle i(4),(p(6).x,p(6).y),dt,dotcol,,,,f 
            Case 5
                  Circle i(5),(p(1).x,p(1).y),dt,dotcol,,,,f 
                  Circle i(5),(p(3).x,p(3).y),dt,dotcol,,,,f 
                  Circle i(5),(p(4).x,p(4).y),dt,dotcol,,,,f 
                  Circle i(5),(p(6).x,p(6).y),dt,dotcol,,,,f 
                  Circle i(5),(p(7).x,p(7).y),dt,dotcol,,,,f 
            Case 6
                  For z As Long=1 To 6
                        Circle i(6),(p(z).x,p(z).y),dt,dotcol,,,,f 
                  Next z
            End Select
      Next
End Sub



Dim As Any Ptr im=Imagecreate(128/2,128),back=Imagecreate(800,600),other=Imagecreate(200,200,Rgb(0,100,255))

'======== draw stuff to images and set up gl ===========

setupgl
For x As Long=0 To 128\2
      For y As Long=0 To 128
            Pset im,(x,y),Rgb(x*4,x*4 xor y*4,y*4)
      Next y
Next x
Circle im,(32,64),20,Rgb(200,0,0),,,,f

For n As Long=0 To 600
      Var red=map(0,600,n,0,255)
      Var green=map(0,600,n,0,255)
      Var blue=map(0,600,n,100,255)
      Line back,(0,n)-(1024,n),Rgb(red,green,blue)
Next
Circle back,(512,10000),10000-410,Rgb(0,100,0),,,,f

Draw String im,(10,100),"Hello",Rgb(255,255,255)

Circle other,(100,100),50,0
Draw String other,(20,20),"Find me a bitmap"
'=======================================
Redim As Any Ptr f()'set up 6 die faces
setdice(f(),180,Rgb(255,255,255),Rgb(0,0,0))
Dim As gluint tex(1 To 6)
For n As Long=1 To 6
      settexture(tex(n),f(n))
Next n

Dim As gluint tex1,tex2,tex3 
settexture(tex1,im)
settexture(tex2,back)
settexture(tex3,other)

Dim As Integer x = 0
Dim As Long fps,dx=100,dy=208
Dim As Single angle


Do
      angle+=.5
      glClear(GL_COLOR_BUFFER_BIT)
      glEnable (GL_CULL_FACE)
      saveprojection
      
      makeortho 
      
      glEnable( GL_TEXTURE_2D )
      glBindTexture(GL_TEXTURE_2D,tex2)'back
      drawquad(Type(800,0),Type(0,0),Type(0,600),Type(800,600))
      
      
      glBindTexture(GL_TEXTURE_2D, tex1)'moving box
      drawquad(Type(x,80),Type(x-63,80),Type(x-63, 127+80),Type( x, 127+80))
      
      glBindTexture(GL_TEXTURE_2D, tex3)'still box
      drawquad(Type(200+dx,0+dy),Type(0+dx,0+dy),Type(0+dx,200+dy),Type(200+dx,200+dy))
      
      x += 1: If (x > 639) Then x = 0
      
      restoreprojection
      
      DrawGlCube(angle,tex())
      gldisable( GL_TEXTURE_2D ) 'to get drawstring colours
      
      drawstring(20,20,"framerate = " &fps,Rgb(0,200,0),1,800,600)
      drawstring(20,40,"refreshrate = " &refreshrate,Rgb(0,200,0),1,800,600)
      drawstring(20,60,"driver = " +driver,Rgb(200,200,0),1,800,600)
      Flip
      
      #ifdef __fb_win32__
      settimer
      Sleep regulate(refreshrate*3,fps)
      freetimer
      #Else
      Sleep regulate(refreshrate*3,fps)
      #endif
Loop While Inkey = ""
Imagedestroy im
Imagedestroy  back
Imagedestroy other
for n as long=1 to 6
      imagedestroy f(n)
      next n


End
 
PavelUT
Posts: 78
Joined: Jun 14, 2021 14:42

Re: FreeBasic+OpenGL. Help

Post by PavelUT »

dodicat wrote:I use 1.08.0, but there are known bugs, so maybe 1.07 is OK.
I am unsure why it is smoother than gfx, I only have win 10 to test.
Here, for fun, is an added complication.
Still runs smoothly here.

Code: Select all

#include "GL/gl.bi"
#include "GL/glext.bi"
#include "gl/glu.bi"
#include "fbgfx.bi"
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Screenres 800,600,32
Dim As Long refreshrate
Dim As String driver
Screeninfo ,,,,,refreshrate'BUG??  refreshrate wrong on opengl screen

Screenres 800, 600, 32,,2
Screeninfo ,,,,,,driver
Width 800\8,600\16 'full fonts on image

#ifdef __fb_win32__
Declare Function settimer       Alias "timeBeginPeriod"(As Ulong=1) As Long
Declare Function freetimer      Alias "timeEndPeriod"  (As Ulong=1) As Long
#endif

Type Point
      As Long x,y
End Type
Sub setupgl 
      Dim As Integer xres,yres
      Screeninfo xres,yres
      glShadeModel(GL_SMOOTH)                 ' Enables Smooth Color Shading
      glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST) 
      glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
      glEnable GL_ALPHA
      glEnable GL_BLEND
      glViewport(0, 0, xres, yres)       ' Set the viewport
      glMatrixMode(GL_PROJECTION)        ' Change Matrix Mode to Projection
      glLoadIdentity                     ' Reset View
      gluPerspective(45.0, xres/yres, 1.0, 100.0) 
      glMatrixMode(GL_MODELVIEW)         ' Return to the modelview matrix
      glLoadIdentity                     '  Reset View
      glclearcolor 1,.5,0,1
End Sub


Sub saveprojection
      glMatrixMode GL_PROJECTION 'save projection
      glPushMatrix
      glMatrixMode GL_MODELVIEW
      glPushMatrix
End Sub

Sub makeortho
      Dim As Long xres,yres
      Screeninfo xres,yres
      glMatrixMode GL_PROJECTION 'make ortho
      glLoadIdentity
      glOrtho 0, xres, yres, 0,-1, 1
      glMatrixMode GL_MODELVIEW
      glLoadIdentity
End Sub

Sub restoreprojection
      glMatrixMode GL_PROJECTION 'restore
      glPopMatrix
      glMatrixMode GL_MODELVIEW
      glPopMatrix 
End Sub


Sub drawstring(xpos As Long,ypos As Long,text As String ,col As Ulong,size As Single,xres As Long,yres As Long) Export
      glMatrixMode GL_PROJECTION 'save projection
      glPushMatrix
      glMatrixMode GL_MODELVIEW
      glPushMatrix
      
      glMatrixMode GL_PROJECTION 'make ortho
      glLoadIdentity
      glOrtho 0, xres, yres, 0,-1, 1
      glMatrixMode GL_MODELVIEW
      glLoadIdentity
      #define Red(c) ((c) Shr 16 And 255)
      #define Green(c) ((c) Shr  8 And 255)
      #define Blue(c) ((c) And 255)
      #define Alph(c) ((c) Shr 24)
      glColor4ub Red(col),Green(col),Blue(col),alph(col)
      glend
      glpointsize(1.1*size)
      glBegin (GL_POINTS)
      Type D2
            As Single x,y
      End Type
      Static As d2 cpt(),XY()
      Static As Long runflag
      If runflag=0 Then   
            Redim  XY(128,127)
            Redim cpt(1 To 64*2)
            Screen 8
            Width 640\8,200\16
            Dim As Ulong Pointer img
            Dim count As Long
            For ch As Long=1 To 127
                  img=Imagecreate(640,200)
                  Draw String img,(1,1),Chr(ch)
                  For x As Long=1 To 8
                        For y As Long=1 To 16
                              If Point(x,y,img)<>0 Then
                                    count=count+1
                                    XY(count,ch)=Type<D2>(x,y)
                              End If
                        Next y
                  Next x
                  count=0
                  Imagedestroy img
            Next ch
            runflag=1
      End If
      If size=0 Then Exit Sub
      Dim As D2 np,t
      #macro Scale(p1,p2,d)
      np.x=d*(p2.x-p1.x)+p1.x
      np.y=d*(p2.y-p1.y)+p1.y
      #endmacro
      
      Dim As D2 c=Type<D2>(xpos,ypos)
      Dim As Long dx=xpos,dy=ypos
      For z6 As Long=1 To Len(text)
            Var asci=text[z6-1]
            For _x1 As Long=1 To 64*2
                  t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy)         
                  Scale(c,t,size)
                  cpt(_x1)=np
                  
                  If XY(_x1,asci).x<>0 Then
                        If Abs(size)>0 Then
                              glVertex3f (cpt(_x1).x,(cpt(_x1).y),0)
                        End If
                  End If
            Next _x1
            dx=dx+8
      Next z6
      glend
      glMatrixMode GL_PROJECTION 'restore
      glPopMatrix
      glMatrixMode GL_MODELVIEW
      glPopMatrix
End Sub

Sub inittext Constructor
      drawstring(0,0,"",0,0,0,0)
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
      Static As Double timervalue,lastsleeptime,t3,frames
      frames+=1
      If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
      Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
      If sleeptime<1 Then sleeptime=1
      lastsleeptime=sleeptime
      timervalue=Timer
      Return sleeptime
End Function

Sub settexture(Byref texture As gluint, image As Any Ptr)
      glGenTextures(1, @texture)
      glBindTexture( GL_TEXTURE_2D, texture )
      glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )   
      glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
      glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
      glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
End Sub

Sub drawquad(p1 As Point,p2 As Point,p3 As Point,p4 As Point)
      'start at top right, go anti-clockwise
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex2f( p1.x, p1.y)            'Top right of the quad
      glTexCoord2f( 0,0 )
      glVertex2f(p2.x,p2.y)          'Top left of the quad
      glTexCoord2f( 0,1 )
      glVertex2f(p3.x,p3.y)      ' Bottom left of the quad
      glTexCoord2f( 1,1 )
      glVertex2f( p4.x,p4.y)        ' Bottom right of the quad
      glend
End Sub

Sub DrawGlCube(Byref rotangle As Single,f() As gluint)
      glLoadIdentity()
      glTranslatef(1,0,-10)
      glRotatef(rotangle,1,.5,.25)           ' Rotate 
      glBindTexture(GL_TEXTURE_2D,f(1))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top right of the quad (top)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top left of the quad (top)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Bottom left of the quad (top)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Bottom right of the quad (top)
      glend
      glBindTexture(GL_TEXTURE_2D,f(6))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )       
      glVertex3f( 1.0,-1.0, 1.0)            ' Top right of the quad (bottom)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Top left of the quad (bottom)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom left of the quad (bottom)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0,-1.0,-1.0)            ' Bottom right of the quad (bottom)
      glend
      glBindTexture(GL_TEXTURE_2D,f(2))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Top right of the quad (front)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Top left of the quad (front)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Bottom left of the quad (front)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0,-1.0, 1.0)            ' Bottom right of the quad (front)
      glend
      glBindTexture(GL_TEXTURE_2D,f(5))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0,-1.0,-1.0)            ' Bottom left of the quad (back)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom right of the quad (back)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top right of the quad (back)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top left of the quad (back)
      glend
      glBindTexture(GL_TEXTURE_2D,f(3))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Top right of the quad (left)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top left of the quad (left)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom left of the quad (left)
      glTexCoord2f( 1,1 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Bottom right of the quad (left)
      glend
      glBindTexture(GL_TEXTURE_2D,f(4))
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top right of the quad (right)
      glTexCoord2f( 0,0 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Top left of the quad (right)
      glTexCoord2f( 0,1 )
      glVertex3f( 1.0,-1.0, 1.0)            ' Bottom left of the quad (right)
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0,-1.0,-1.0)
      glend
End Sub
Sub setdice(i() As Any Ptr,size As Long,facecol As Ulong=Rgb(200,200,0),dotcol As Ulong=Rgb(0,0,0)) 'create images
      Type v
            As Long x,y
      End Type
      Dim As v p(1 To 7)
      Redim i(1 To 6)
      Dim As Long sz=size,dt=sz/12
      p(1)=Type(sz/4,sz/4)
      p(2)=Type(sz/4,sz/2)
      p(3)=Type(sz/4,3*sz/4)
      p(4)=Type(3*sz/4,sz/4)
      p(5)=Type(3*sz/4,sz/2)
      p(6)=Type(3*sz/4,3*sz/4)
      p(7)=Type(sz/2,sz/2)
      
      For n As Long=1 To 6
            i(n)=Imagecreate(sz,sz,facecol)
            
            Line i(n),(0,0)-(sz-1,sz-1),dotcol,b
            Draw String i(1),(5,5),"Text size test",Rgb(0,0,200)
            Select Case n
            Case 1
                  Circle i(1),(p(7).x,p(7).y),dt,dotcol,,,,f
            Case 2
                  Circle i(2),(p(1).x,p(1).y),dt,dotcol,,,,f
                  Circle i(2),(p(6).x,p(6).y),dt,dotcol,,,,f
            Case 3
                  Circle i(3),(p(1).x,p(1).y),dt,dotcol,,,,f
                  Circle i(3),(p(7).x,p(7).y),dt,dotcol,,,,f
                  Circle i(3),(p(6).x,p(6).y),dt,dotcol,,,,f
            Case 4
                  Circle i(4),(p(1).x,p(1).y),dt,dotcol,,,,f 
                  Circle i(4),(p(3).x,p(3).y),dt,dotcol,,,,f 
                  Circle i(4),(p(4).x,p(4).y),dt,dotcol,,,,f 
                  Circle i(4),(p(6).x,p(6).y),dt,dotcol,,,,f 
            Case 5
                  Circle i(5),(p(1).x,p(1).y),dt,dotcol,,,,f 
                  Circle i(5),(p(3).x,p(3).y),dt,dotcol,,,,f 
                  Circle i(5),(p(4).x,p(4).y),dt,dotcol,,,,f 
                  Circle i(5),(p(6).x,p(6).y),dt,dotcol,,,,f 
                  Circle i(5),(p(7).x,p(7).y),dt,dotcol,,,,f 
            Case 6
                  For z As Long=1 To 6
                        Circle i(6),(p(z).x,p(z).y),dt,dotcol,,,,f 
                  Next z
            End Select
      Next
End Sub



Dim As Any Ptr im=Imagecreate(128/2,128),back=Imagecreate(800,600),other=Imagecreate(200,200,Rgb(0,100,255))

'======== draw stuff to images and set up gl ===========

setupgl
For x As Long=0 To 128\2
      For y As Long=0 To 128
            Pset im,(x,y),Rgb(x*4,x*4 xor y*4,y*4)
      Next y
Next x
Circle im,(32,64),20,Rgb(200,0,0),,,,f

For n As Long=0 To 600
      Var red=map(0,600,n,0,255)
      Var green=map(0,600,n,0,255)
      Var blue=map(0,600,n,100,255)
      Line back,(0,n)-(1024,n),Rgb(red,green,blue)
Next
Circle back,(512,10000),10000-410,Rgb(0,100,0),,,,f

Draw String im,(10,100),"Hello",Rgb(255,255,255)

Circle other,(100,100),50,0
Draw String other,(20,20),"Find me a bitmap"
'=======================================
Redim As Any Ptr f()'set up 6 die faces
setdice(f(),180,Rgb(255,255,255),Rgb(0,0,0))
Dim As gluint tex(1 To 6)
For n As Long=1 To 6
      settexture(tex(n),f(n))
Next n

Dim As gluint tex1,tex2,tex3 
settexture(tex1,im)
settexture(tex2,back)
settexture(tex3,other)

Dim As Integer x = 0
Dim As Long fps,dx=100,dy=208
Dim As Single angle


Do
      angle+=.5
      glClear(GL_COLOR_BUFFER_BIT)
      glEnable (GL_CULL_FACE)
      saveprojection
      
      makeortho 
      
      glEnable( GL_TEXTURE_2D )
      glBindTexture(GL_TEXTURE_2D,tex2)'back
      drawquad(Type(800,0),Type(0,0),Type(0,600),Type(800,600))
      
      
      glBindTexture(GL_TEXTURE_2D, tex1)'moving box
      drawquad(Type(x,80),Type(x-63,80),Type(x-63, 127+80),Type( x, 127+80))
      
      glBindTexture(GL_TEXTURE_2D, tex3)'still box
      drawquad(Type(200+dx,0+dy),Type(0+dx,0+dy),Type(0+dx,200+dy),Type(200+dx,200+dy))
      
      x += 1: If (x > 639) Then x = 0
      
      restoreprojection
      
      DrawGlCube(angle,tex())
      gldisable( GL_TEXTURE_2D ) 'to get drawstring colours
      
      drawstring(20,20,"framerate = " &fps,Rgb(0,200,0),1,800,600)
      drawstring(20,40,"refreshrate = " &refreshrate,Rgb(0,200,0),1,800,600)
      drawstring(20,60,"driver = " +driver,Rgb(200,200,0),1,800,600)
      Flip
      
      #ifdef __fb_win32__
      settimer
      Sleep regulate(refreshrate*3,fps)
      freetimer
      #Else
      Sleep regulate(refreshrate*3,fps)
      #endif
Loop While Inkey = ""
Imagedestroy im
Imagedestroy  back
Imagedestroy other
for n as long=1 to 6
      imagedestroy f(n)
      next n


End
 
You did not understand a little. Moving the rectangle in your OpenGl program happens without distortion on my Raspberry. My program is distorted when moved. You are doing something that I am not doing.
I have a request to you - simplify your program, remove everything except moving a one-color rectangle on a colored background. I will try to compare the result and find a fundamental difference.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBasic+OpenGL. Help

Post by dodicat »

OK
I have left drawquad with the four parameters (points), the top right is first then go anti clockwise.
I added the texture parameter to drawquad, it seems cleaner that way.
I have kept the regulate function to keep the framerate steady.
I cannot get the refreshrate from an opengl screen, so I have a gfx screen momentarily at the beginning.
But the refreshrate is not too important anyway, just set you own framerate in sleep regulate().
I don't have to gldisable( GL_TEXTURE_2D ) so I enabled it outside the loop.
I have kept the background, a sky like picture.
I think the rest I have already done before.
I have kept the windows option open ( #ifdef __fb_win32__), but it will be ignored of course in non windows OS.

Code: Select all


#include "GL/gl.bi"
#include "GL/glext.bi"
#include "fbgfx.bi"
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)

Screenres 800,600,32
Dim As Long refreshrate
Dim As String driver
Screeninfo ,,,,,refreshrate'  BUG??  refreshrate wrong on opengl screen

Screenres 800, 600, 32,,2
Screeninfo ,,,,,,driver
Width 800\8,600\16 'full fonts on image

#ifdef __fb_win32__
Declare Function settimer       Alias "timeBeginPeriod"(As Ulong=1) As Long
Declare Function freetimer      Alias "timeEndPeriod"  (As Ulong=1) As Long
#endif

Type Point
      As Long x,y
End Type

Sub setupgl
    Dim As Integer xres,yres
    Screeninfo xres,yres
    glDisable (GL_DEPTH_TEST)
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    glEnable (GL_BLEND)
    glEnable (GL_LINE_SMOOTH)
    glOrtho 0, xres, yres,0,-1, 1
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
      Static As Double timervalue,lastsleeptime,t3,frames
      frames+=1
      If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
      Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
      If sleeptime<1 Then sleeptime=1
      lastsleeptime=sleeptime
      timervalue=Timer
      Return sleeptime
End Function

Sub settexture(Byref texture As gluint, image As Any Ptr)
      glGenTextures(1, @texture)
      glBindTexture( GL_TEXTURE_2D, texture )
      glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )   
      glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
      glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
      glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
End Sub

Sub drawquad(p1 As Point,p2 As Point,p3 As Point,p4 As Point,texture as gluint)
      glBindTexture(GL_TEXTURE_2D,texture)
      'start at top right, go anti-clockwise
      glBegin(GL_QUADS)
      glTexCoord2f( 1,0 )
      glVertex2f( p1.x, p1.y)            'Top right of the quad
      glTexCoord2f( 0,0 )
      glVertex2f(p2.x,p2.y)          'Top left of the quad
      glTexCoord2f( 0,1 )
      glVertex2f(p3.x,p3.y)      ' Bottom left of the quad
      glTexCoord2f( 1,1 )
      glVertex2f( p4.x,p4.y)        ' Bottom right of the quad
      glend
End Sub


Dim As Any Ptr im=Imagecreate(128/2,128),back=Imagecreate(800,600)

'======== draw stuff to images and set up gl ===========

setupgl

For x As Long=0 To 128\2 'moving box
      For y As Long=0 To 128
            Pset im,(x,y),Rgb(x*4,x*4 xor y*4,y*4)
      Next y
Next x
Circle im,(32,64),20,Rgb(200,0,0),,,,f
Draw String im,(10,100),"Hello",Rgb(255,255,255)
'====
For n As Long=0 To 600 'background
      Var red=map(0,600,n,0,255)
      Var green=map(0,600,n,0,255)
      Var blue=map(0,600,n,100,255)
      Line back,(0,n)-(1024,n),Rgb(red,green,blue)
Next
Circle back,(512,10000),10000-410,Rgb(0,100,0),,,,f

'=======================================

Dim As gluint moving_box,background
settexture(moving_box,im)
settexture(background,back)


Dim As Integer x 
Dim As Long fps


 glEnable( GL_TEXTURE_2D )
Do
      
      glClear(GL_COLOR_BUFFER_BIT)
    
      drawquad(Type(800,0),Type(0,0),Type(0,600),Type(800,600),background)
     
      drawquad(Type(x,80),Type(x-63,80),Type(x-63, 127+80),Type( x, 127+80),moving_box)
     
     
      x += 1: If (x > 639) Then x = 0
   
      Flip
     
      #ifdef __fb_win32__
      settimer
      Sleep regulate(refreshrate*3,fps)
      freetimer
      #Else
      Sleep regulate(refreshrate*3,fps)
      #endif
      windowtitle "framerate "&fps
Loop While Inkey = ""
Imagedestroy im
Imagedestroy  back


End
 
  
PavelUT
Posts: 78
Joined: Jun 14, 2021 14:42

Re: FreeBasic+OpenGL. Help

Post by PavelUT »

EDIT: I just noticed that you didn't take alignment of the FB image buffers into account, and modified the loadTexture() function accordingly. Check the note inside the function to see how this is done in OpenGL, and why you need to do it when working with Fb.Image buffers.

Code: Select all

'Redesigned for 2D sprite 07/06/21
'Load BMP  ' 
' result     free(): invalid pointer Aborted


#include once "fbgfx.bi"
Using FB
#include "GL/gl.bi"
#include "GL/glu.bi"
#INCLUDE "file.bi"

Dim Shared As Gluint texture (2) 'array and 2 texture IDs

Const scrnX = 800 '1024
Const scrnY = 600 '768
Const depth = 32
Const fullscreen = &h0 ' Полноэкранный режим ( &h0 = обычный, &h1 = полноэкранный )
'Const fullscreen = &h1 ' Полноэкранный режим ( &h0 = обычный, &h1 = полноэкранный )

Screenres scrnX, scrnY, depth ,, &h2 Or fullscreen, GFX_MULTISAMPLE

Screeninfo scrnX, scrnY
Windowtitle "OpenGL 2D Sprite"
Dim As short xscr = 20, yscr = 100 'start coordinates of yellow rectangle

Dim As Integer spr_sizeX = 112, spr_sizeY = 180 'sprite size
Dim As Integer fon_sizeX = 400, fon_sizeY = 400 'background sizes

Sub setupgl
'OpenGL configuration
glMatrixMode (GL_PROJECTION) 'Matrix definition
glLoadIdentity
glViewport (0,0, scrnX, scrnY) 'Set the coordinate axis
glOrtho (0, scrnX, scrnY, 0, -128,128)
glMatrixMode (GL_MODELVIEW) 'Disable rendering of invisible parts
glShadeModel (GL_FLAT)
glEnable (GL_SMOOTH)
glCullFace (GL_BACK)
glEnable GL_TEXTURE_2D 'Enable textures
glLoadIdentity
glEnable (GL_DEPTH_TEST) 'Depth Test
glDepthFunc (GL_LESS)
glEnable (GL_ALPHA_TEST) 'Test Alpha
glAlphaFunc (GL_GREATER, 0.1)
End Sub

Dim As Byte Ptr img_fon
'Dim As Byte Ptr img

img_fon = ImageCreate (fon_sizeX, fon_sizeY, RGBA (255, 100, 100, 128), 32)
'img = ImageCreate (spr_sizeX, spr_sizeY, RGBA (255, 255, 255, 128), 32) 'Image bilden

'' loading sprite background 400x400
Bload ("texttrava123.bmp", img_fon)
glGenTextures (1, @texture (0))
glBindTexture GL_TEXTURE_2D, texture (0)

glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT)
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT)
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR 'this is required!
glTexImage2D GL_TEXTURE_2D, 0, GL_RGBA, fon_sizeX, fon_sizeY, 0, GL_BGRA, GL_UNSIGNED_BYTE, img_fon +32
ImageDestroy img_fon 'Pixel data is received, memory is freed

'' loading sprite boy 112x180
 #define __BM_WINDOWS__ &h4D42
 
  type __BITMAPFILEHEADER__ field = 1
    as ushort id
    as ulong size
    as ubyte reserved( 0 to 3 )
    as ulong offset
  end type
 
  type __BITMAPINFOHEADER__ field = 1
    as ulong size
    as long width
    as long height
    as ushort planes
    as ushort bpp
    as ulong compression_method
    as ulong image_size
    as ulong h_res
    as ulong v_res
    as ulong color_palette_num
    as ulong colors_used
  end type
 
  dim as Fb.Image ptr img = 0
  'dim Shared as GLuint texture1 = 0
 dim as GLuint texture1 = 0
 
  'if( fileExists( path ) ) then
  if( fileExists( "gars112_180_1.bmp" ) ) then
    dim as __BITMAPFILEHEADER__ header
    dim as __BITMAPINFOHEADER__ info
   
    dim as long f = freeFile()
   
    open "gars112_180_1.bmp" for binary as f
      get #f, , header
      get #f, sizeof( header ) + 1, info
    close( f )
   
    '' Check if the file is indeed a Windows bitmap
    if( header.id = __BM_WINDOWS__ ) then
      img = imageCreate( info.width, info.height )
      bload( "gars112_180_1.bmp", img )
     
      glGenTextures( 1, @texture1 )
      glBindTexture( GL_TEXTURE_2D, texture1 )
     ' glGenTextures (2, @texture (1))
   ' glBindTexture (GL_TEXTURE_2D, texture (1)) 'texture binding
     
      /'
        ** IMPORTANT **
        These two calls are needed to tell OpenGL about the _alignment_ of the FB buffers,
        since image buffers are aligned to a paragraph (16 bytes) boundary and may have
        padding pixels at the end of each scanline.
      '/
      glPixelStorei( GL_UNPACK_ALIGNMENT, 4 )
      glPixelStorei( GL_UNPACK_ROW_LENGTH, img->pitch \ sizeof( ulong ) )
     
      glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, img->width, img->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, _
        cast( ulong ptr, img ) + sizeof( Fb.Image ) \ sizeof( ulong ) )
     
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE )
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE )
     
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR )
      glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR )
     
      '' we're finished so unbind the texture
      glBindTexture( GL_TEXTURE_2D, 0 )
      imageDestroy( img )
    end if
  end if
 
ImageDestroy img 'Pixel data is received, memory is freed

sub spr_surf_fon (xscr as short, yscr as short, zscr as short, fon_sizeX as short, fon_sizeY as short)
 ' the background

 glTranslatef 0,0, -1 'z = -1 location coordinates x, y, z
 GlBindTexture (GL_TEXTURE_2D, texture (0))
 glBegin GL_QUADS
 glColor4ub 255,255,255,255 'set the white color of the rectangle Rd, Gd, Bd, Ad)
 glTexCoord2f 0, 1 'binds texture coordinates to object vertices.
 glVertex2i 0, fon_sizeY '' Bottom left (1st coordinate)
 glTexCoord2f 1, 1
 glVertex2i fon_sizeX, fon_sizeY '' Bottom right (2.coordinate)
 glTexCoord2f 1,0
 glVertex2i fon_sizeX, 0 '' Top right (3.coordinate)
 glTexCoord2f 0, 0
 glVertex2i 0, 0 '' Top left (4th coordinate)
 glEnd
 
  glLoadIdentity
   end sub


sub spr_surf (xscr as short, yscr as short, zscr as short, xspr_size as short, yspr_size as short)

 glTranslatef xscr, 300,2 'z = 2 location coordinates x, y, z
 'GlBindTexture GL_TEXTURE_2D, texture1
 GlBindTexture GL_TEXTURE_2D, texture (1)
 glBegin GL_QUADS
 glColor4ub 255,255,255,255 'set the white color of the rectangle Rd, Gd, Bd, Ad)
 glTexCoord2f 0, 1 'binds texture coordinates to object vertices.
 glVertex2i 0, yspr_size '' Bottom left (1st coordinate)
 glTexCoord2f 1, 1
 glVertex2i xspr_size, yspr_size '' Bottom right (2.coordinate)
 glTexCoord2f 1, 0
 glVertex2i xspr_size, 0 '' Top right (3.coordinate)
 glTexCoord2f 0, 0
 glVertex2i 0, 0 '' Top left (4th coordinate)
 glEnd

  glLoadIdentity
   end sub
   
  setupgl

Do
 glClearColor (0.5f, 0.7f, 0.5f, 1.0f) 'setting the background color
 glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT 'clear the background

  '' reset coordinates
  GLLoadIdentity ()
  spr_surf_fon (xscr, yscr, 0, fon_sizeX, fon_sizeY) 'display background 400x400

  spr_surf (xscr, yscr, 0, spr_sizeX, spr_sizeY) 'display the sprite 112x180
 '
 '!! there are different teams here !!
  xscr + = 2: If (xscr> 720) Then xscr = 0 'sprite movement
 
  GLLoadIdentity ()
  
  'Square B
 glTranslatef 150,200,1 'z = 1
 glBegin GL_QUADS
 glColor4ub 0,0,255,200 'blue square
 glTexCoord2f 0, 0
 glVertex2i 0, 100 '' Bottom left (1st coordinate)
 glTexCoord2f 1, 0
 glVertex2i 100, 100 '' Bottom right (2nd coordinate)
 glTexCoord2f 1, 1
 glVertex2i 100, 0 '' Top right (3rd coordinate)
  glTexCoord2f 0, 1
 glVertex2i 0, 0 '' Top left (4th coordinate)
 glEnd
 glLoadIdentity
 
  
  glFlush 'Command Handling
  Flip 'switching screens

  glBindTexture GL_TEXTURE_2D, 0 'Free texture

Loop While Inkey$ = ""
End 
I can't run the program with your BMP bootloader. (Writes - free (): invalid pointer
Aborted) Please see what I did wrong.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBasic+OpenGL. Help

Post by dodicat »

I think that post was for paul doe? But here is an easy way to get a bitmap width and height.

Code: Select all

#include "file.bi"
Sub getsize(bmp As String,Byref w As long,Byref h As long)
    Open bmp For Binary As #1
    Get #1, 19, w
    Get #1, 23, h
    Close #1
End Sub


screen 20,32
dim as any ptr i=imagecreate(123,456,rgb(0,100,255))
circle i,(123\2,456\2),50,rgb(200,0,0),,,,f

bsave "myimage.bmp",i
imagedestroy i
'==============================
dim as long w,h
getsize("myimage.bmp",w,h)
if w*h =0  then print "bitmap not found":sleep:end
dim as any ptr newimage=imagecreate(w,h)

bload "myimage.bmp",newimage
put(0,0),newimage,pset
locate 10,20
print w,h

kill "myimage.bmp"
locate 12,20
print iif(fileexists("myimage.bmp"),"Delete the bmp manually","OK")
sleep
imagedestroy newimage
 
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: FreeBasic+OpenGL. Help

Post by paul doe »

PavelUT wrote:...Please see what I did wrong.
Who knows? The code works here (fbc 1.08.0).
coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: FreeBasic+OpenGL. Help

Post by coderJeff »

PavelUT wrote: I can't run the program with your BMP bootloader. (Writes - free (): invalid pointer
Aborted) Please see what I did wrong.
@PavelUT, This looks suspicious. Freeing same pointer twice?
PavelUT wrote:

Code: Select all

      imageDestroy( img )
    end if
  end if
ImageDestroy img 'Pixel data is received, memory is freed
Sorry, I didn't try running this on anything. Earlier advice already given to tidy up the code in to re-usable procedures (like the BMP loader) might help isolate the errors.
PavelUT
Posts: 78
Joined: Jun 14, 2021 14:42

Re: FreeBasic+OpenGL. Help

Post by PavelUT »

dodicat wrote:I think that post was for paul doe? But here is an easy way to get a bitmap width and height.

Code: Select all

#include "file.bi"
Sub getsize(bmp As String,Byref w As long,Byref h As long)
    Open bmp For Binary As #1
    Get #1, 19, w
    Get #1, 23, h
    Close #1
End Sub


screen 20,32
dim as any ptr i=imagecreate(123,456,rgb(0,100,255))
circle i,(123\2,456\2),50,rgb(200,0,0),,,,f

bsave "myimage.bmp",i
imagedestroy i
'==============================
dim as long w,h
getsize("myimage.bmp",w,h)
if w*h =0  then print "bitmap not found":sleep:end
dim as any ptr newimage=imagecreate(w,h)

bload "myimage.bmp",newimage
put(0,0),newimage,pset
locate 10,20
print w,h

kill "myimage.bmp"
locate 12,20
print iif(fileexists("myimage.bmp"),"Delete the bmp manually","OK")
sleep
imagedestroy newimage
 
Thanks for the tip, but my program is just the backbone to learn OpenGl right now. If someone can tell me something about OpenGl, I will be very grateful.
Post Reply