Using cubes and painting openGL to an FB screen.
Which one is FBGFX and which one is OpenGL?
Code: Select all
#include "windows.bi"
#include "GL\glu.bi"
Sub glinit(xres As Long,yres As Long)
glViewport 0, 0, xres, yres '' Reset The Current Viewport
glMatrixMode GL_PROJECTION '' Select The Projection Matrix
glLoadIdentity '' Reset The Projection Matrix
gluPerspective 45.0, xres/yres, 0.1, 100.0 '' Calculate The Aspect Ratio Of The Window
glMatrixMode GL_MODELVIEW '' Select The Modelview Matrix
glLoadIdentity '' Reset The Modelview Matrix
'' All Setup For OpenGL Goes Here
glShadeModel GL_SMOOTH '' Enable Smooth Shading
glClearColor 0.0, 0.0, 0.0, 0.5 '' Black Background
glClearDepth 1.0 '' Depth Buffer Setup
glEnable GL_DEPTH_TEST '' Enables Depth Testing
glDepthFunc GL_LEQUAL '' The Type Of Depth Testing To Do
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
End Sub
Sub gLcube(angle As Single)
glLoadIdentity '' Reset The Current Modelview Matrix
glTranslatef 1.6, 0.0, -7.5 '' Move Right 1.6 Units And Into The Screen 7.5
glRotatef angle,1.0, 1.0, 1.0 '' Rotate The Quad On The X axis
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
glBegin GL_QUADS
glColor3f 0.0, 1.0, 0.0
glVertex3f 1.0, 1.0, -1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f 1.0, 1.0, 1.0
glColor3f 1.0, 0.5, 0.0
glVertex3f 1.0, -1.0, 1.0
glVertex3f -1.0, -1.0, 1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f 1.0, -1.0, -1.0
glColor3f 1.0, 0.0, 0.0
glVertex3f 1.0, 1.0, 1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f -1.0, -1.0, 1.0
glVertex3f 1.0, -1.0, 1.0
glColor3f 1.0, 1.0, 0.0
glVertex3f 1.0, -1.0, -1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f 1.0, 1.0, -1.0
glColor3f 0.0, .5, 1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f -1.0, -1.0, 1.0
glColor3f 1.0, 0.0, 1.0
glVertex3f 1.0, 1.0, -1.0
glVertex3f 1.0, 1.0, 1.0
glVertex3f 1.0, -1.0, 1.0
glVertex3f 1.0, -1.0, -1.0
glEnd
glFlush()
End Sub
Dim Shared As Integer refresh_rate
Dim Shared As Integer w,h
Type screendata
As Integer w,h,depth,pitch
As Any Pointer row
End Type
Type V3
As Single x,y,z
As Ulong col
As Single grad
As Long xi
End Type
Sub fillpolygon(a() As V3, c As Ulong,miny As Long,maxy As Long,s As screendata)
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
'Mostly translated by forum member Pitto
#define ppset32(_x,_y,colour) *Cptr(Ulong Ptr,s.row+ (_y)*s.pitch+ (_x) Shl 2) =(colour)
#define onscreen ((x1)>=0) Andalso ((x1)<(s.w-1)) Andalso ((y1)>=0) Andalso ((y1)<(s.h-1))
Dim As Long LB=Lbound(a),UB=Ubound(a)
For i As Long=lb To Ub - 1
Var dy=a(i+1).y-a(i).y
Var dx=a(i+1).x-a(i).x
If dy=0 Then a(i).grad=1
If dx=0 Then a(i).grad=0
If dy <> 0 Andalso dx <> 0 Then
a(i).grad = dx / dy
End If
Next i
For y As Long=miny To maxy
Var k = lb
For i As Long=lb To Ub - 1
If ( a(i).y<=y Andalso a(i+1).y>y) Orelse (a(i).y>y Andalso a(i+1).y<=y) Then
a(k).xi= (a(i).x+a(i).grad*(y-a(i).y))
k +=1
End If
Next i
For j As Long = lb To k-2 -1
For i As Long = lb +1 To k-2
If a(i).xi > a(i+1).xi Then
Swap a(i).xi,a(i+1).xi
End If
Next i
Next j
Dim As Long e
For i As Long = lb To k - 2 Step 2
'bressenham line inlined
Dim As Long x1= a(i).xi ,y1= y,x2=a(i+1).xi+1,y2= y
Var dx=Abs(x2-x1),dy=0,sx=Sgn(x2-x1),sy=0
If dx<dy Then e=dx\2 Else e=dy\2
Do
If onscreen Then
ppset32((x1),(y1),c)
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
Next i
Next y
End Sub
Sub drawpolygon(p() As V3,i As Long,s As screendata)
Static As Single miny=1e6,maxy=-1e6
Static As v3 V(1 To Ubound(p,2)+1)
For n As Long=1 To Ubound(p,2)
If miny>p(i,n).y Then miny=p(i,n).y
If maxy<p(i,n).y Then maxy=p(i,n).y
V(n)=p(i,n)
Next
v(Ubound(v))=v(Lbound(v))
fillpolygon(v(),p(i,1).col,miny,maxy,s)
End Sub
Function Rotate(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,p.col)
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 sort(array() As V3,painter() As Long)
For p1 As Long = 1 To Ubound(array,1) - 1
For p2 As Long = p1 + 1 To Ubound(array,1)
If array(p1,0).z<array(p2,0).z Then Swap painter(p1),painter(p2):Swap array(p1,0),array(p2,0)
Next p2
Next p1
End Sub
Sub Expand(p() As V3,b As Single,shift As V3,i As Long)
For n As Long=Lbound(p,2) To Ubound(p,2)
p(i,n).x=b*p(i,n).x+shift.x
p(i,n).y=b*p(i,n).y+shift.y
p(i,n).z=b*p(i,n).z+shift.z
Next n
End Sub
'=========================================================
'set the cube faces on (0,0,0) as centre
Dim Shared As V3 g1(1 To ...,1 To ...)={{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front
{(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_ 'right
{(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_'back
{(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_'left
{(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_'top
{(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}'base
'set colours,save in 1st. index
g1(1,1).col=Rgb(0,255,0):g1(2,1).col=Rgb(255,255\2,0):g1(3,1).col=Rgb(255,0,0):g1(4,1).col=Rgb(255,255,0):g1(5,1).col=Rgb(0,255\2,255):g1(6,1).col=Rgb(255,0,255)
Screen 20,32
Dim Shared As screendata S
With S
Screeninfo .w,.h,.depth,,.pitch
.row=Screenptr
End With
'blow up and translate the cube to screen centre
For i As Long=Lbound(g1,1) To Ubound(g1,1)
Expand (g1(),120,Type<v3>(s.w\4,s.h\2,0),i)
Next i
Dim Shared As Long painter(1 To 6)
For n As Long=1 To 6:painter(n)=n:Next n
Dim Shared As V3 eye:eye= Type<V3>(s.w\4,s.h\2,800)
Dim As String i
Dim Shared As V3 fulcrum:fulcrum=Type<V3>(s.w\4,s.h\2,0) ' middle of cube
Dim Shared As Long fps
Sub fbcube(angle As V3)
Dim As Long cx,cy,cz 'centriods
Static As V3 tmp1(1 To Ubound(g1,1),0 To Ubound(g1,2))'the working array
For m As Long=Lbound(g1,1) To Ubound(g1,1)
cx=0:cy=0:cz=0
For n As Long=1 To Ubound(g1,2)
tmp1(m,n)=Rotate(fulcrum,g1(m,n),angle)
tmp1(m,n)=perspective(tmp1(m,n),eye) 'apply the eye (perspective)
cx+=tmp1(m,n).x:cy+=tmp1(m,n).y:cz+=tmp1(m,n).z
Next n
cx=cx/4:cy=cy/4:cz=cz/4
'get face centroid into zero'th index
tmp1(m,0)=Type<v3>(cx,cy,cz)
Next m
'sort the faces by centriods
sort(tmp1(),painter())
For z As Long=Lbound(tmp1,1)+3 To Ubound(tmp1,1)'Paint only the closest three faces
Var p=painter(z)
Select Case p
Case 1: drawpolygon(tmp1(),p,s)
Case 2: drawpolygon(tmp1(),p,s)
Case 3: drawpolygon(tmp1(),p,s)
Case 4: drawpolygon(tmp1(),p,s)
Case 5: drawpolygon(tmp1(),p,s)
Case 6: drawpolygon(tmp1(),p,s)
End Select
Next z
'reset painter
For n As Long=1 To 6:painter(n)=n:Next n
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
'from glwin2
Sub SetUpglTOfbscreen(Byref pPixels As Ubyte Ptr,x As Long,y As Long )
Dim As Any Ptr MemoryDC,ScreenDC 'HDC
Dim As Any Ptr RenderContext 'HGLRC
Dim As Any Ptr Bitmap
Dim As BITMAPINFO BI
Dim As PIXELFORMATDESCRIPTOR PfD
Dim As Integer PixelFormat
ScreenDC=GetDC(0) 'CreateDC("DISPLAY",NULL,NULL,NULL)
MemoryDC=CreateCompatibleDC(ScreenDC)
With BI.bmiHeader
.biSize = Sizeof(BITMAPINFOHEADER)
.biWidth = x
.biHeight =-y
'.biSizeImage = 512*512*2
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
.biXPelsPerMeter = 0
.biYPelsPerMeter = 0
.biClrUsed = 0
.biClrImportant = 0
End With
Bitmap=CreateDIBSection(MemoryDC,@BI,DIB_RGB_COLORS,@pPixels,NULL,0)
SelectObject(MemoryDC,Bitmap)
With PfD
.nSize = Sizeof(PIXELFORMATDESCRIPTOR)
.nVersion = 1
.dwFlags = PFD_DRAW_TO_BITMAP Or PFD_SUPPORT_OPENGL Or PFD_SUPPORT_GDI
.iPixelType = PFD_TYPE_RGBA
.iLayerType = PFD_MAIN_PLANE
.cColorBits = 24
.cDepthBits = 24
.cAlphaBits = 8
'.cAccumBits = 0
'.cStencilBits = 0
End With
PixelFormat = ChoosePixelFormat(MemoryDC,@PfD)
SetPixelFormat(MemoryDC,PixelFormat,@PfD)
RenderContext=wglCreateContext(MemoryDC)
wglMakeCurrent(MemoryDC,RenderContext)
End Sub
'superimpose via screenptr
Sub Drawgl(p As Ubyte Ptr,pPixels As Ubyte Ptr,xx As Long,yy As Long)
Dim As Long i
For y As Long=0 To xx-1
For x As Long=0 To yy-1
p[i*4+0]= pPixels[i*3+0]
p[i*4+1]= pPixels[i*3+1]
p[i*4+2]= pPixels[i*3+2]
i+=1
Next
Next
End Sub
Sub Start()
Screen 20,32
Screeninfo w,h
Screencontrol 8,refresh_rate
Dim As Any Ptr pPixels
'Dim Win As Any Ptr=Screenptr
Var Ip = Cptr(Integer Ptr,@ppixels )
Screencontrol 2,*Ip
Print ppixels
'==== opengl ===========
SetUpglTOfbscreen(pPixels,w,h) 'gl to fb
glinit(w,h) 'initialize the open gl
'========================
Const pi=4*Atn(1)
Dim As Long fps
Dim As v3 a
a.y=pi
Dim As Single gla
While 1
gla+=1
a.x+=.01/2
a.y+=.02/2
a.z+=.03/2
Screenlock
Cls
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
DrawGl(Screenptr,pPixels,w,h) 'transfer openGL to fb screen
GLcube(gla)
FBcube(a)
Draw String(50, 10), " Press escape key to end", Rgb(255, 200, 0)
Draw String(50, 55), "framerate " &fps , Rgb(0, 200, 0)
'Draw String(w\4-50,110),"fbgfx cube"
'Draw String(3*w\4-50,110),"openGL cube"
Screenunlock
glflush
Sleep regulate(refresh_rate, fps)
If Inkey=Chr(27) Then Exit While
Wend
End Sub
start