Code: Select all
#include once "fbgfx.bi"
#Include Once "GL/glu.bi"
#include "GL/glext.bi"
Dim Shared As Integer xres,yres
Screenres 1024,768,32,,2 Or 64
Screeninfo xres,yres
'Simple structure just to hold corners of one quad
Type pair
As Single x,y
End Type
Operator *(x As Double,n As pair) As pair
Return Type<pair>(x*n.x,x*n.y)
End Operator
Type v3
As Single x,y,z
End Type
Function RotatePoint(c As V3,p As v3,angle As V3,scale As V3=Type<V3>(1,1,1)) As V3
Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
Return Type<V3>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
(scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
(scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)
End Function
Function perspective(p As v3,eyepoint As v3) As v3
Dim As Single w=1+(p.z/eyepoint.z)
Return Type<v3>((p.x-eyepoint.x)/w+eyepoint.x,_
(p.y-eyepoint.y)/w+eyepoint.y,_
(p.z-eyepoint.z)/w+eyepoint.z)',p.col)
End Function
Sub drawstring(xpos As Long,ypos As Long,text As String ,col As Ulong,size As Single,xres As Long,yres As Long)
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 Filter(Byref tim As Ulong Pointer,_
Byval rad As Long,_
Byval destroy As Long=1,_
Byval fade As Long=0) As Ulong Pointer
#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
If fade<0 Then fade=0:If fade>100 Then fade=100
Type p2
As Long x,y
As Ulong col
End Type
#macro ppoint(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
(colour)=*pixel
#endmacro
#macro ppset(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
*pixel=(colour)
#endmacro
#macro average()
ar=0:ag=0:ab=0:inc=0
xmin=x:If xmin>rad Then xmin=rad
xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
ymin=y:If ymin>rad Then ymin=rad
ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
For y1 As Long=-ymin To ymax
For x1 As Long=-xmin To xmax
inc=inc+1
ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
ab=ab+(NewPoints(x+x1,y+y1).col And 255)
Next x1
Next y1
If fade=0 Then
averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
Else
averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
End If
#endmacro
Dim As Single fd=map(0,100,fade,1,0)
Dim As Integer _x,_y
Imageinfo tim,_x,_y
Dim As Ulong Pointer im=Imagecreate(_x,_y)
Dim As Integer pitch
Dim As Any Pointer row
Dim As Ulong Pointer pixel
Dim As Ulong col
Imageinfo tim,,,,pitch,row
Dim As p2 NewPoints(_x-1,_y-1)
For y As Long=0 To (_y)-1
For x As Long=0 To (_x)-1
ppoint(x,y,col)
NewPoints(x,y)=Type<p2>(x,y,col)
Next x
Next y
Dim As Ulong averagecolour
Dim As Long ar,ag,ab
Dim As Long xmin,xmax,ymin,ymax,inc
Imageinfo im,,,,pitch,row
For y As Long=0 To _y-1
For x As Long=0 To _x-1
average()
ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour)
Next x
Next y
If destroy Then Imagedestroy tim: tim = 0
Function= im
End Function
Sub cloud(x As Long, y As Long,length As Long=100,Alpha As Long=155, Zoom As Single = 0,im As Any Pointer=0)
Dim As Long rr=255
Dim As Long bb=255
Dim As Long gg=255
Dim As Double pi=3.14159
#define mp(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
If Length<=1 Or Alpha<=1 Then Exit Sub
Dim As Single rnded = -pi+Rnd*1*pi/2
Dim As Single rnded2 = -pi+Rnd*-3*pi
If Alpha<25 Then
For i As Long = 0 To 255-Alpha Step 100
Var c=mp((0),(700),y,0,100)
Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded*PI/3),y+Length/6+length*Sin(-pi/2+rnded*PI/3)),Rgba(Rr-c,Gg-c,Bb-c,Alpha)
Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded2*PI/3),y+Length/6+length*Sin(pi/2+rnded2*PI/3)),Rgba(Rr-c,Gg-c,Bb-c,Alpha)
Next
End If
cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded*PI/3),(Zoom/2)+y+length*Sin(-pi/2+rnded*PI/3),length/1.4,Alpha/1.2,Zoom,im)
cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi/2+rnded2*PI/3),length/1.4,Alpha/1.2,Zoom,im)
cloud(-(Zoom/2)+x+length*Cos(pi/3+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi+rnded2*PI/3),length/1.4,Alpha/2,Zoom,im)
End Sub
'Create a FreeBasic image
Sub CreateFBimageBackground(Byref im2 As Any Ptr)
Dim As Single minx,maxx,miny,maxy,lasty,grad
#define dist(x1,y1,x2,y2) Sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#macro paintsketch(_function,r,g,b)
For x As Double=minx To maxx Step (maxx-minx)/5000
Dim As Double x1=(xres)*(x-minx)/(maxx-minx)
Dim As Double y1=(yres)*(_function-maxy)/(miny-maxy)
grad=y1-lasty
lasty=y1
grad=grad*250
Line im2,(x1,0)-(x1,yres-y1),Rgb(r+grad,g+grad,b)
Next x
#endmacro
#macro _window(topleftX,topleftY,bottomrightX,bottomrightY)
minx=topleftX
maxx=bottomrightX
miny=bottomrightY
maxy=topleftY
#endmacro
For x As Long=0 To xres
For y As Long=0 To yres
Var d=dist(x,y,(.69*xres),(.79*yres))
Var r=map(0,800,d,255,0)
Var g=map(0,800,d,255,0)
Var b=map(0,800,d,250,255)
Pset im2,(x,y),Rgb(r,g,b)
Next y
Next x
_window(-5,3,25,-1.2)
paintsketch(.05*Sin(x)+.05*Sin(2*x),100,100,50)
_window(5,2,30,-.8)
paintsketch(.1*Sin(x),100,100,0)
_window(1,2,12,-.6)
paintsketch(.1*Sin(x),100,100,0)
_window(0,2,8,-.5)
paintsketch(.2*Sin(x),100,100,0)
cloud(800,500,50,,,im2)
im2=filter(im2,1)
End Sub
'Set a Quad to hold image
Sub setbackgroundquad(e() As pair)
Dim As Single r1=xres/yres,r2=1 'same ratio as screen
Dim As Single n=1 'left open for a fiddle around
e(1)=n*Type(-r1,r2)
e(2)=n*Type(r1,r2)
e(3)=n*Type(r1,-r2)
e(4)=n*Type(-r1,-r2)
End Sub
Sub DrawBackGroundQuad(e() As pair)
Dim As Single n=1
glLoadIdentity()
glTranslatef(0,0,-2) 'adjust the z translate for a good fit
glbegin gl_quads
glTexCoord2f( 0,n )
glvertex3f(e(1).x,e(1).y,0)
glTexCoord2f( n,n )
glvertex3f(e(2).x,e(2).y,0)
glTexCoord2f( n,0 )
glvertex3f(e(3).x,e(3).y,0)
glTexCoord2f( 0,0 )
glvertex3f(e(4).x,e(4).y,0)
glend
End Sub
Sub glsetup
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
End Sub
'Transfer FB image to OpenGL
Sub settexture( 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
'Rotate and draw the cube with texturing on each face
Sub DrawGlCube(Byref rotangle As Single)
Static As Double a
a+=.0075
Static As v3 p
p=Type<v3>(-7,0,-9)
Var r=rotatepoint(Type<v3>(0,0,-15),p,Type<v3>(0,a,0),Type(1,1,1.1))
r=perspective(r,Type(0,0,-30))
glLoadIdentity()
glTranslatef(r.x,r.y,r.z)
glRotatef(rotangle,1,.5,.25) ' Rotate
glBegin(GL_QUADS)
glTexCoord2f( 1,1 )
glVertex3f( 1.0, 1.0,-1.0) ' Top right of the quad (top)
glTexCoord2f( 0,1 )
glVertex3f(-1.0, 1.0,-1.0) ' Top left of the quad (top)
glTexCoord2f( 0,0 )
glVertex3f(-1.0, 1.0, 1.0) ' Bottom left of the quad (top)
glTexCoord2f( 1,0 )
glVertex3f( 1.0, 1.0, 1.0) ' Bottom right of the quad (top)
glTexCoord2f( 1,1 )
glVertex3f( 1.0,-1.0, 1.0) ' Top right of the quad (bottom)
glTexCoord2f( 0,1 )
glVertex3f(-1.0,-1.0, 1.0) ' Top left of the quad (bottom)
glTexCoord2f( 0,0 )
glVertex3f(-1.0,-1.0,-1.0) ' Bottom left of the quad (bottom)
glTexCoord2f( 1,0 )
glVertex3f( 1.0,-1.0,-1.0) ' Bottom right of the quad (bottom)
glTexCoord2f( 1,1 )
glVertex3f( 1.0, 1.0, 1.0) ' Top right of the quad (front)
glTexCoord2f( 0,1 )
glVertex3f(-1.0, 1.0, 1.0) ' Top left of the quad (front)
glTexCoord2f( 0,0 )
glVertex3f(-1.0,-1.0, 1.0) ' Bottom left of the quad (front)
glTexCoord2f( 1,0 )
glVertex3f( 1.0,-1.0, 1.0) ' Bottom right of the quad (front)
glTexCoord2f( 1,1 )
glVertex3f( 1.0,-1.0,-1.0) ' Bottom left of the quad (back)
glTexCoord2f( 0,1 )
glVertex3f(-1.0,-1.0,-1.0) ' Bottom right of the quad (back)
glTexCoord2f( 0,0 )
glVertex3f(-1.0, 1.0,-1.0) ' Top right of the quad (back)
glTexCoord2f( 1,0 )
glVertex3f( 1.0, 1.0,-1.0) ' Top left of the quad (back)
glTexCoord2f( 1,1 )
glVertex3f(-1.0, 1.0, 1.0) ' Top right of the quad (left)
glTexCoord2f( 0,1 )
glVertex3f(-1.0, 1.0,-1.0) ' Top left of the quad (left)
glTexCoord2f( 0,0 )
glVertex3f(-1.0,-1.0,-1.0) ' Bottom left of the quad (left)
glTexCoord2f( 1,0 )
glVertex3f(-1.0,-1.0, 1.0) ' Bottom right of the quad (left)
glTexCoord2f( 1,1 )
glVertex3f( 1.0, 1.0,-1.0) ' Top right of the quad (right)
glTexCoord2f( 0,1 )
glVertex3f( 1.0, 1.0, 1.0) ' Top left of the quad (right)
glTexCoord2f( 0,0 )
glVertex3f( 1.0,-1.0, 1.0) ' Bottom left of the quad (right)
glTexCoord2f( 1,0 )
glVertex3f( 1.0,-1.0,-1.0)
glend
End Sub
Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
Static As Double timervalue,_lastsleeptime,t3,frames
Var t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
_lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
'Some variables
Dim As gluint tex1
Dim As Any Ptr background=Imagecreate(xres,yres)
Dim As pair BackgroundCorners(1 To 4)
CreateFBimageBackground(background)
setbackgroundquad(BackgroundCorners())
'NOW START OPENGL
glsetup
'transfer freebasic image to openGL
settexture(tex1,background)
'enable texturing
glEnable( GL_TEXTURE_2D )
Dim As Single angle
Dim As Long fps
Do
angle=angle+1
glClear(GL_COLOR_BUFFER_BIT)
'freebasic image is planted onto the background quad
DrawBackGroundQuad(BackgroundCorners())
drawstring(50,50,"Framerate = " &fps,Rgb(0,0,0),1,xres,yres)
'standard rotate cube
'with image planted to each face
glEnable (GL_CULL_FACE)
DrawGlcube(angle)
gldisable(GL_CULL_FACE)
glend
Flip
Sleep regulate(60,fps),1
Loop Until Inkey=Chr(27)
Imagedestroy background