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