$INCLUDE <RapidQ2.inc>
$INCLUDE <GL\QGL.inc>
'-----------------------------------------------
'sample working code, from Don's example
'-----------------------------------------------
' user procedures prototype
declare sub MakeMods
declare sub initfx
declare sub redraw
declare sub wipeoff
declare sub sizeit
declare sub isescape(key as byte)
declare sub chgshp(sender as QMENUITEM)
declare sub drawquad
declare sub drawcube
declare sub renderSphere (x as single, y as single, z as single)
' user variables
defsng xrot = 0.0 '' X Rotation ( NEW )
defsng yrot = 0.5 '' Y Rotation ( NEW )
defsng zrot = 0.0 '' Z Rotation ( NEW )
DIM myTexture AS GLuint :myTexture = 0
defint tcs = 1
'create our wrapper
DIM GL AS QGL
' Render Timer engine
create tmx as QTimer
interval = 1
enabled = 1
onTimer = redraw
end create
Dim sphobj AS GLUquadricObj
DIM Bmodel as glInt
DIM Qmodel as glInt
' user interface
create fx as QFORM
caption = "RQGL Demo"
top = 16
left = 26
width = 640
height = 480
create fxmnu as QMAINMENU
create fxshp as QMENUITEM
caption = "Show"
create shp0 as QMENUITEM
caption = "&2D Quad"
checked = 1
onClick = chgshp
end create
create shp1 as QMENUITEM
caption = "&3D Cube"
checked = 0
onClick = chgshp
end create
create shp2 as QMENUITEM
caption = "&Sphere"
checked = 0
onClick = chgshp
end create
create sp as QMENUITEM
caption = "-"
end create
create xit as QMENUITEM
caption = "E&xit"
onClick = wipeoff
end create
end create
end create
create ST as QSTATUSBAR
Enabled = 1
AddPanels "Esc - quit","Loading..."
end create
onPaint = redraw
onResize = sizeit
onKeyPress = isescape
onClick = wipeoff
onShow = initfx
end create
' main program
fx.ShowModal
end
'user procedures
sub initfx
GL.Init(fx)
' fx.BorderStyle = bsNone
' GL.FullScreen = True
GL.MipMap = GL_LINEAR_MIPMAP_LINEAR 'or GL_NEAREST_MIPMAP_NEAREST or GL_LINEAR_MIPMAP_NEAREST,or GL_NEAREST_MIPMAP_LINEAR
myTexture = GL.CreateTextureFromFile("back.bmp") 'load texture, put id in myTexture
IF myTexture = 0 THEN fx.Close
'' All Setup For OpenGL Goes Here
glEnable GL_TEXTURE_2D '' Enable Texture Mapping ( NEW )
glShadeModel GL_SMOOTH '' Enable Smooth Shading
glClearColor 0.5, 0.5, 0.5, 1.0 '' grey Background
glClearDepth 1.0 '' Depth Buffer Setup
' glEnable GL_DEPTH_TEST '' Enables Depth Testing
' glDepthFunc GL_LEQUAL '' The Type Of Depth Testing To Do
' Translucency, Blending
' glBlendFunc(GL_SRC_ALPHA, GL_ONE)
' glEnable(GL_BLEND)
' glEnable(GL_CULL_FACE)
' glCullFace(GL_FRONT) ' This creates problem in glPrint
' light moves with translation, rotation of modelview
' DEFSNG LightPos(3) = {0.5, 0.5, 3.0, 1.0}
' glLightfv(GL_LIGHT0, GL_POSITION, LightPos(0))
' glEnable(GL_LIGHTING)
' glEnable(GL_LIGHT0)
DEFSNG Material(2) = {0.1745, 0.01175, 0.01175}
glMaterialfv (GL_FRONT, GL_AMBIENT, Material(0))
DEFSNG DiffMaterial(0) = {0.61424, 0.04136, 0.04136}
glMaterialfv (GL_FRONT, GL_DIFFUSE, DiffMaterial(0))
DEFSNG SpecMaterial(0) = {0.727811, 0.626959, 0.626959}
glMaterialfv (GL_FRONT, GL_SPECULAR, SpecMaterial(0))
glMaterialf (GL_FRONT, GL_SHININESS, 0.6*128.0)
GL.FogEnabled = True
GL.FogMode = GL_EXP
GL.FogColor(0.5, 0.5, 0.5)
GL.SetFogParams(Gl.Front, Gl.Back, 0.52)
glClearColor(0.5, 0.5, 0.5, 1.0) ' fog color
glMatrixMode GL_MODELVIEW '' Select The Modelview Matrix
glLoadIdentity '' Reset The Modelview Matrix
RenderSphere(0.0, 0.0, -2.0)
MakeMods
redraw
end sub
sub sizeit
GL.Resize(fx.clientWidth, fx.clientHeight)
end sub
sub drawquad
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT '' Clear Screen And Depth Buffer
glPushMatrix
glMatrixMode GL_MODELVIEW '' Select The Modelview Matrix
glLoadIdentity
IF zrot >-6 THEN zrot -= 0.02
glTranslatef 0.00, 0.00, zrot '' Rotate On The X Axis
' glRotatef(xrot, 1.0, 0.0, 0.0) 'rotate the plane
' glRotatef(yrot, 0.0, 1.0, 0.0) 'rotate the plane
glRotatef(zrot*2, 0.0, 0.0, 1.0) 'rotate the plane
' glBindTexture GL_TEXTURE_2D, myTexture '' Select new Texture here if needed
glCallList(Qmodel)
glPopMatrix
end sub
SUB DrawSphere
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT '' Clear Screen And Depth Buffer
glPushMatrix
glMatrixMode GL_MODELVIEW '' Select The Modelview Matrix
glLoadIdentity '' Reset The Modelview Matrix
IF zrot >-6 THEN zrot -= 0.02
glTranslatef (0.0, 0.0, zrot)
gluSphere(sphobj, 0.4, 16, 16)
glPopMatrix
END SUB
SUB DrawCube
DIM i AS INTEGER
fx.Caption = "FPS = " + str$(GL.FrameRate)
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT '' Clear Screen And Depth Buffer
glPushMatrix
glMatrixMode GL_MODELVIEW '' Select The Modelview Matrix
glLoadIdentity '' Reset The Modelview Matrix
' gluLookAt(0.0, 1.0, -.5, 0.0, -0.2, -1.0, 0.0, 1.0, 0.0)
xrot += .05
yrot += .5
' zrot += .5
IF zrot >-6 THEN zrot -= 0.02
glTranslatef 0.00, 0.00, zrot '' translate before rotate
glRotatef xrot,1.0, 0.0, 0.0 '' Rotate On The X Axis
glRotatef yrot,0.0, 1.0, 0.0 '' Rotate On The Y Axis
glRotatef zrot,0.0, 0.0, 1.0 '' Rotate On The Z Axis
' glBindTexture GL_TEXTURE_2D, myTexture '' Select new Texture if needed
' glColor3f 1.0, 1.0 ,1.0 'set all vertices to white
glCallList(Bmodel)
glPopMatrix
END SUB
sub redraw
ST.Panel(1).caption="GLWin W-"+str$(fx.width)+_
" x H-"+str$(fx.height)
select case tcs
case 1
drawquad
case 2
drawcube
case 3
drawSphere
end select
'Fx.TextOut(5,5,"Hello", &HFFFFFF,-1)
GL.Flip 'SwapBuffers GL.hDC ' flip -- backbuffer to the screen
end sub
sub isescape(key as byte)
if key=VK_ESCAPE then fx.close
end sub
sub wipeoff
GL.Close
fx.close
end sub
sub chgshp(sender as QMENUITEM)
if sender.caption="&3D Cube" then
tcs=2
shp0.checked=0
shp1.checked=1
shp2.checked=0
glEnable GL_DEPTH_TEST '' Enables Depth Testing for cube
glDepthFunc GL_LEQUAL '' The Type Of Depth Testing To Do
else
if sender.caption="&Sphere" then
tcs=3
shp2.checked=1
shp1.checked=0
shp0.checked=0
glDisable GL_DEPTH_TEST '' no Depth Testing for plane
else
tcs=1
shp1.checked=0
shp0.checked=1
shp2.checked=0
glDisable GL_DEPTH_TEST '' no Depth Testing for plane
end if
end if
zrot =0
end sub
' --------------- end code --------
sub renderSphere (x as single, y as single, z as single)
glPushMatrix
glTranslatef (x, y, z)
glColor3f(1.0, 1.0, 1.0)
sphobj=gluNewQuadric()
gluQuadricDrawStyle(sphobj, GLU_FILL)
gluQuadricNormals(sphobj, GLU_SMOOTH)
gluSphere(sphobj, 0.4, 16, 16)
glPopMatrix
end sub
SUB MakeMods
DIM i as integer
DEFSNG BoxObj (0 TO 71) = {_ '0-71 : 3 * 24
-1.0, -1.0, 1.0, _'Back Face
1.0, -1.0, 1.0, _
1.0, 1.0, 1.0, _
-1.0, 1.0, 1.0, _
-1.0, -1.0, -1.0, _'Top Face
-1.0, 1.0, -1.0, _
1.0, 1.0, -1.0, _
1.0, -1.0, -1.0, _
-1.0, 1.0, -1.0, _'Bottom Face
-1.0, 1.0, 1.0, _
1.0, 1.0, 1.0, _
1.0, 1.0, -1.0, _
-1.0, -1.0, -1.0, _'Right face
1.0, -1.0, -1.0, _
1.0, -1.0, 1.0, _
-1.0, -1.0, 1.0, _
1.0, -1.0, -1.0, _
1.0, 1.0, -1.0, _
1.0, 1.0, 1.0, _'Left Face
1.0, -1.0, 1.0, _
-1.0, -1.0, -1.0, _
-1.0, -1.0, 1.0, _
-1.0, 1.0, 1.0, _
-1.0, 1.0, -1.0}
DEFSNG TexCoords(0 TO 47) = { _'0-47 2 * 24
0.0, 0.0,_ 'Front Face
1.0, 0.0,_
1.0, 1.0,_
0.0, 1.0,_
1.0, 0.0,_'Back Face
1.0, 1.0,_
0.0, 1.0,_
0.0, 0.0,_
0.0, 1.0,_'Top Face
0.0, 0.0,_
1.0, 0.0,_
1.0, 1.0,_
1.0, 1.0,_'Bottom Face
0.0, 1.0,_
0.0, 0.0,_
1.0, 0.0,_
1.0, 0.0,_'Right face
1.0, 1.0,_
0.0, 1.0,_
0.0, 0.0,_
0.0, 0.0,_'Left Face
1.0, 0.0,_
1.0, 1.0,_
0.0, 1.0}
Bmodel = glGenLists( 1 )
glNewList( Bmodel, GL_COMPILE)
glBegin GL_QUADS
glColor3f 1.0, 1.0 ,1.0 'set all vertices to white
glColor3f 1.0, 1.0 ,1.0 'set all vertices to white
' DEFSNG Clrs(2) = {1.0, 1.0, 1.0}
for i = 0 to 23
'unrem if you want to combine colors and texture
' glColor3fv Clrs(0) 'Note pass first element of array
glTexCoord2fv TexCoords(i*2)
glVertex3fv BoxObj(i*3)
next i
' ' Front Face
' glTexCoord2f 0.0, 0.0 : glVertex3f -0.5, -0.5, 0.5 '' Bottom Left Of The Texture and Quad
' glTexCoord2f 1.0, 0.0 : glVertex3f 0.5, -0.5, 0.5 '' Bottom Right Of The Texture and Quad
' glTexCoord2f 1.0, 1.0 : glVertex3f 0.5, 0.5, 0.5 '' Top Right Of The Texture and Quad
' glTexCoord2f 0.0, 1.0 : glVertex3f -0.5, 0.5, 0.5 '' Top Left Of The Texture and Quad
' ' Back Face
' glTexCoord2f 1.0, 0.0 : glVertex3f -0.5, -0.5, -0.5 '' Bottom Right Of The Texture and Quad
' glTexCoord2f 1.0, 1.0 : glVertex3f -0.5, 0.5, -0.5 '' Top Right Of The Texture and Quad
' glTexCoord2f 0.0, 1.0 : glVertex3f 0.5, 0.5, -0.5 '' Top Left Of The Texture and Quad
' glTexCoord2f 0.0, 0.0 : glVertex3f 0.5, -0.5, -0.5 '' Bottom Left Of The Texture and Quad
' ' Top Face
' glTexCoord2f 0.0, 1.0 : glVertex3f -0.5, 0.5, -0.5 '' Top Left Of The Texture and Quad
' glTexCoord2f 0.0, 0.0 : glVertex3f -0.5, 0.5, 0.5 '' Bottom Left Of The Texture and Quad
' glTexCoord2f 1.0, 0.0 : glVertex3f 0.5, 0.5, 0.5 '' Bottom Right Of The Texture and Quad
' glTexCoord2f 1.0, 1.0 : glVertex3f 0.5, 0.5, -0.5 '' Top Right Of The Texture and Quad
' ' Bottom Face
' glTexCoord2f 1.0, 1.0 : glVertex3f -0.5, -0.5, -0.5 '' Top Right Of The Texture and Quad
' glTexCoord2f 0.0, 1.0 : glVertex3f 0.5, -0.5, -0.5 '' Top Left Of The Texture and Quad
' glTexCoord2f 0.0, 0.0 : glVertex3f 0.5, -0.5, 0.5 '' Bottom Left Of The Texture and Quad
' glTexCoord2f 1.0, 0.0 : glVertex3f -0.5, -0.5, 0.5 '' Bottom Right Of The Texture and Quad
' ' Right face
' glTexCoord2f 1.0, 0.0 : glVertex3f 0.5, -0.5, -0.5 '' Bottom Right Of The Texture and Quad
' glTexCoord2f 1.0, 1.0 : glVertex3f 0.5, 0.5, -0.5 '' Top Right Of The Texture and Quad
' glTexCoord2f 0.0, 1.0 : glVertex3f 0.5, 0.5, 0.5 '' Top Left Of The Texture and Quad
' glTexCoord2f 0.0, 0.0 : glVertex3f 0.5, -0.5, 0.5 '' Bottom Left Of The Texture and Quad
' ' Left Face
' glTexCoord2f 0.0, 0.0 : glVertex3f -0.5, -0.5, -0.5 '' Bottom Left Of The Texture and Quad
' glTexCoord2f 1.0, 0.0 : glVertex3f -0.5, -0.5, 0.5 '' Bottom Right Of The Texture and Quad
' glTexCoord2f 1.0, 1.0 : glVertex3f -0.5, 0.5, 0.5 '' Top Right Of The Texture and Quad
' glTexCoord2f 0.0, 1.0 : glVertex3f -0.5, 0.5, -0.5 '' Top Left Of The Texture and Quad
glEnd
glEndList
Qmodel = glGenLists( 1 )
glNewList( Qmodel, GL_COMPILE)
glBegin(GL_QUADS)
glTexCoord2i(0, 0)
glColor3f 0.1,0.1,1.0
glVertex3f(-0.5, -0.5, 0)
glTexCoord2i(0, 1)
glColor3f 0.1,1.0,0.1
glVertex3f(-0.5, 0.5, 0.0)
glTexCoord2i(1, 1)
glColor3f 1.0,0.1,0.1
glVertex3f(0.5, 0.5, 0.0)
glTexCoord2i(1, 0)
glColor3f 1.0,0.1,0.1
glVertex3f(0.5, -0.5, 0.0)
glEnd
glEndList
END SUB