At a first read glwin2.bas seems cryptic, but in essence it provides a method to superimpose openGL graphics to a normal screen.
windows code only
-gen gas for best results.
Example:
Code: Select all
#include "windows.bi"
#include "GL\glu.bi"
'NEHE
'from lesson5, this and the cube
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
glclearcolor 0,0,.3,1
End Sub
'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,OldBitmap ' HBITMAP
dim as BITMAPINFO BI
dim as PIXELFORMATDESCRIPTOR PfD
dim as integer PixelFormat
ScreenDC=GetDC(0) 'CreateDC("DISPLAY",NULL,NULL,NULL)
if ScreenDC then
MemoryDC=CreateCompatibleDC(ScreenDC)
if MemoryDC then
with BI.bmiHeader
.biSize = sizeof(BITMAPINFOHEADER)
.biWidth = x'800'512
.biHeight =-y'-600'-512
'.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)
if Bitmap then
OldBitmap=SelectObject(MemoryDC,Bitmap)
if OldBitmap then
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)
if PixelFormat then
if SetPixelFormat(MemoryDC,PixelFormat,@PfD) then
RenderContext=wglCreateContext(MemoryDC)
if RenderContext=0 then
dim as zstring ptr pszMessage
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or _
FORMAT_MESSAGE_FROM_SYSTEM or _
FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, GetLastError(), _
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _
cptr(any ptr,@pszMessage),0, NULL )
SelectObject(MemoryDC,OldBitmap)
DeleteObject(Bitmap)
DeleteDC(MemoryDC)
DeleteDC(ScreenDC)
print "error create opengl render context: " & *pszMessage
beep:sleep:end
end if ' create render context
else
? "error: set pixelformat!"
end if ' set pixelformat
else
? "error: choose pixelformat!"
end if ' choose pixelformat
else
? "error: select bitmap!"
end if ' select bitmap in DC
else
? "error: DIB section!"
end if ' offscreen bitmap
else
? "error: memory dc!"
end if ' memory DC
else
? "error: screen dc!"
end if ' screen DC
if wglMakeCurrent(MemoryDC,RenderContext)=0 then
? "error: make current!"
beep:sleep
end if
end sub
'lesson5 cube
sub UpDateGlProc
static as single angle
angle+=.2
glLoadIdentity '' Reset The Current Modelview Matrix
glTranslatef 1, 0.0, -5.0 '' Move Right 1.5 Units And Into The Screen 7.0
glRotatef angle,1.0, 1.0, 1.0 '' Rotate The Quad On The X axis ( NEW )
glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
glBegin GL_QUADS '' Draw A Quad
glColor3f 0.0, 1.0, 0.0
glVertex3f 1.0, 1.0, -1.0 '' Top Right Of The Quad (Top)
glVertex3f -1.0, 1.0, -1.0
glColor3f 1.0, 1.0, 1.0 '' Top Left Of The Quad (Top)
glVertex3f -1.0, 1.0, 1.0 '' Bottom Left Of The Quad (Top)
glVertex3f 1.0, 1.0, 1.0 '' Bottom Right Of The Quad (Top)
glColor3f 1.0, 0.5, 0.0 '' Set The Color To Orange
glVertex3f 1.0, -1.0, 1.0 '' Top Right Of The Quad (Bottom)
glVertex3f -1.0, -1.0, 1.0
glColor3f 1.0, 0.5, 1.0 '' Top Left Of The Quad (Bottom)
glVertex3f -1.0, -1.0, -1.0 '' Bottom Left Of The Quad (Bottom)
glVertex3f 1.0, -1.0, -1.0 '' Bottom Right Of The Quad (Bottom)
glColor3f 1.0, 0.0, 0.0 '' Set The Color To Red
glVertex3f 1.0, 1.0, 1.0 '' Top Right Of The Quad (Front)
glVertex3f -1.0, 1.0, 1.0
glColor3f 0.0, 0.0, 1.0 '' Top Left Of The Quad (Front)
glVertex3f -1.0, -1.0, 1.0 '' Bottom Left Of The Quad (Front)
glVertex3f 1.0, -1.0, 1.0 '' Bottom Right Of The Quad (Front)
glColor3f 1.0, 1.0, 0.0 '' Set The Color To Yellow
glVertex3f 1.0, -1.0, -1.0 '' Top Right Of The Quad (Back)
glVertex3f -1.0, -1.0, -1.0
glColor3f .0, .0, 1 '' Top Left Of The Quad (Back)
glVertex3f -1.0, 1.0, -1.0 '' Bottom Left Of The Quad (Back)
glVertex3f 1.0, 1.0, -1.0 '' Bottom Right Of The Quad (Back)
glColor3f 0.0, .5, 1.0 '' Set The Color To Blue
glVertex3f -1.0, 1.0, 1.0 '' Top Right Of The Quad (Left)
glVertex3f -1.0, 1.0, -1.0
glColor3f 1.0, 0.0, 1.0 '' Top Left Of The Quad (Left)
glVertex3f -1.0, -1.0, -1.0 '' Bottom Left Of The Quad (Left)
glVertex3f -1.0, -1.0, 1.0 '' Bottom Right Of The Quad (Left)
glColor3f 1.0, 0.0, 1.0 '' Set The Color To Violet
glVertex3f 1.0, 1.0, -1.0
glColor3f .0, 0.0, 1.0 '' Top Right Of The Quad (Right)
glVertex3f 1.0, 1.0, 1.0 '' Top Left Of The Quad (Right)
glVertex3f 1.0, -1.0, 1.0 '' Bottom Left Of The Quad (Right)
glVertex3f 1.0, -1.0, -1.0 '' Bottom Right Of The Quad (Right)
glEnd '' Done Drawing The Quad
glFlush()
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
'++++++++++++++++++ FREEBASIC SCREEN MOTION +++++++++++++++
type ball
x as single 'position x component
y as single 'position y component
dx as single 'velocity x component
dy as single 'velocity y component
a as single 'angular distance
da as single 'angular speed
col as uLong 'colour
col2 as ulong 'contrast to col (for ball texture)
as Long r,m 'radius, mass
end type
Sub texture(xpos As long,ypos As long,size As long,c1 As Ulong=8,c2 As Ulong=12,an As Single)
#macro rotate(px,py,a,rotx,roty)
rotx=(Cos(a)*(px-xpos)-Sin(a)*(py-ypos)) +xpos
roty=(Sin(a)*(px-xpos)+Cos(a)*(py-ypos)) +ypos
#endmacro
Dim As Single rx,ry,tempx1,tempy1,tempx2,tempy2
Circle (xpos, ypos), size,c2
Var yps1=ypos+size,yps2=ypos-size
Var xps1=xpos+size/2,xps2=xpos-size/2
Var yps3=ypos-size/2,yps4=ypos+size/2
rotate(xpos,yps1,an,rx,ry)
tempx1=rx:tempy1=ry
rotate(xpos,yps2,an,rx,ry)
tempx2=rx:tempy2=ry
Line (tempx1, tempy1)-( tempx2,tempy2),c2
rotate(xps1,ypos,an,rx,ry)
tempx1=rx:tempy1=ry
rotate(xps2,ypos,an,rx,ry)
tempx2=rx:tempy2=ry
Paint(tempx1,tempy1),c2
Paint(tempx2,tempy2),c1,c2
rotate(xpos,yps3,an,rx,ry)
tempx1=rx:tempy1=ry
rotate(xpos,yps4,an,rx,ry)
tempx2=rx:tempy2=ry
Circle (tempx1,tempy1), size/2,c2,,,,f
Circle (tempx2,tempy2), size/2,c1,,,,f
Circle (tempx1,tempy1), size/6,c1,,,,f
Circle (tempx2,tempy2), size/6,c2,,,,f
End Sub
sub MoveAndDraw( b() as ball,byref e as Long,byref ae as long)'get energy also
for n as Long=lbound(b) to ubound(b)
b(n).x+=b(n).dx:b(n).y+=b(n).dy
b(n).a+=b(n).da*(1/b(n).r)
texture(b(n).x,b(n).y,b(n).r,b(n).col,b(n).col2,b(n).a)
e+=.5*b(n).m*(b(n).dx*b(n).dx + b(n).dy*b(n).dy)
ae+=b(n).da*b(n).da
next n
end sub
sub edges(b() as ball,xres as Long,yres as Long,byref status as Long ) 'get status also
for n as Long=lbound(b) to ubound(b)
if(b(n).x<b(n).r) then b(n).x=b(n).r: b(n).dx=-b(n).dx:b(n).da=abs(atan2(b(n).dy,b(n).dx))*sgn(b(n).dy)
if(b(n).x>xres-b(n).r )then b(n).x=xres-b(n).r: b(n).dx=-b(n).dx:b(n).da=-abs(atan2(b(n).dy,b(n).dx))*sgn(b(n).dy)
if(b(n).y<b(n).r)then b(n).y=b(n).r:b(n).dy=-b(n).dy:b(n).da=-abs(atan2(b(n).dy,b(n).dx))*sgn(b(n).dx)
if(b(n).y>yres-b(n).r)then b(n).y=yres-b(n).r:b(n).dy=-b(n).dy:b(n).da=abs(atan2(b(n).dy,b(n).dx))*sgn(b(n).dx)
if b(n).x<0 or b(n).x>xres then status=0
if b(n).y<0 or b(n).y>yres then status=0
next n
end sub
Function DetectBallCollisions( B1 As ball,B2 As ball) As single 'avoid using sqr if they are well seperated
Dim As single xdiff = B2.x-B1.x
Dim As single ydiff = B2.y-B1.y
If Abs(xdiff) > (B2.r+B1.r) Then Return 0
If Abs(ydiff) > (B2.r+B1.r) Then Return 0
var L=Sqr(xdiff*xdiff+ydiff*ydiff)
If L<=(B2.r+B1.r) Then Function=L else Function=0
End Function
sub BallCollisions(b() as ball)
dim as single pi=4*atn(1)
for n1 as Long=lbound(b) to ubound(b)-1
for n2 as Long=n1+1 to ubound(b)
dim as single L= DetectBallCollisions(b(n1),b(n2))
if L then
dim as single impulsex=(b(n1).x-b(n2).x)/L
dim as single impulsey=(b(n1).y-b(n2).y)/L
'set one ball to nearest non overlap position
b(n1).x=b(n2).x+(b(n2).r+b(n1).r)*impulsex
b(n1).y=b(n2).y+(b(n2).r+b(n1).r)*impulsey
dim as single impactx=b(n1).dx-b(n2).dx
dim as single impacty=b(n1).dy-b(n2).dy
dim as single dot=impactx*impulsex+impacty*impulsey
dim as single mn2=b(n1).m/(b(n1).m+b(n2).m),mn1=b(n2).m/(b(n1).m+b(n2).m)
b(n1).dx-=dot*impulsex*2*mn1
b(n1).dy-=dot*impulsey*2*mn1
b(n2).dx+=dot*impulsex*2*mn2
b(n2).dy+=dot*impulsey*2*mn2
dim as single at1=(atan2(b(n1).dy,b(n1).dx)),AT2=(atan2(b(n2).dy,b(n2).dx))
at1=sgn(at1)*iif(at1<0,pi+at1,pi-at1)
at2=sgn(at2)*iif(at2<0,pi+at2,pi-at2)
b(n1).da=at1'was -at1
b(n2).da=at2'was -at1
end if
next n2
next n1
end sub
'stiener circles
sub circles(numballs as long,OutsideRadius as long,cx as long,cy as long,a() as ball)
redim a(1 to numballs+1)
Dim As Double r,bigr,num,x,y,k=OutsideRadius, pi=4*atn(1)
#define rad *pi/180
dim as long counter
num= (45*(2*numballs-4)/numballs) rad
num=Cos(num)
r=num/(1+num)
bigr=((1-r))*k 'radius to ring ball centres
r=(r)*k -1 'radius of ring balls
For z As Double=0 To 2*pi Step 2*pi/numballs
counter+=1
x=cx+bigr*Cos(z)
y=cy+bigr*Sin(z)
if counter>numballs then exit for
a(counter).x=x
a(counter).y=y
a(counter).r=r
Next z
a(ubound(a)).x=cx
a(ubound(a)).y=cy
a(ubound(a)).r=OutsideRadius-r*2-2
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
function contrast(c as ulong) as ulong
#define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
'get the rgb values
dim as ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
do
r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
'get at least 120 ubyte difference
loop until abs(r-r2)>120 andalso abs(g-g2)>120 andalso abs(b-b2)>120
return rgb(r2,g2,b2)
end function
'========================= opengl and gfx combine =========
sub Start()
screen 20,32
dim as ubyte ptr pPixels,p 'for gl
dim as integer xres,yres
screeninfo xres,yres
SetUpglTOfbscreen(pPixels,xres,yres) 'for gl
p=screenptr 'for gl
glinit(xres,yres) 'initialize the open gl with background colour and perspective stuff
'set up fb screen stuff
redim as ball b()
dim as Long fps,energy,status=1,AngEnergy
'setup the ball positions
circles(15,250,xres/3,yres/2,b())
randomize 4
for n as Long=lbound(b) to ubound(b)
with b(n)
.dx=0
.dy=0
.col=rgb(rnd*255,rnd*255,rnd*255)
.col2=contrast(.col)
'.r (determined in circles sub)
.m=.r^2
end with
next
print "Freebasic screen with openGL cube"
print "Press a key"
MoveAndDraw(b(),0,0)'first view (static)
sleep
b(1).dx=12 'set system alive
while 1
UpDateGlProc 'update the cube
energy=0
AngEnergy=0
edges(b(),xres,yres,status)
BallCollisions(b())
screenlock
cls
DrawGl(p,pPixels,xres,yres) 'draw the gl cube
MoveAndDraw(b(),energy,AngEnergy) 'draw the balls
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 (50,100),"Kinetic energy " &energy
draw string (50,140),"Angular energy " & AngEnergy
draw string (50,190),"System stauus " & iif(status,"OK","Leaks")
screenunlock
sleep regulate(65, fps)
if inkey=chr(27) then exit while
wend
end sub
start