hello. Does anybody knows from the openGL profis how to set up a correct "sphere mapping" for this "nehe example 18"? but take attention, for this example I include in "drawscene" function
QuoteglEnable(%GL_TEXTURE_GEN_S)
glEnable(%GL_TEXTURE_GEN_T)
glBindTexture %GL_TEXTURE_2D, TextureHandles(filter)
like nehe built this function for sphere mapping too. if you use arrows (up,down,left,right) and SPACE tab you will see the Sphere with texture but no rotation for texture. I am wondering why this doesn't work. Any help is appreciated.
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "GLU.INC"
#INCLUDE "GDIPLUS.INC"
#INCLUDE "GDIPUTILS.INC"
$WindowCaption = "SphereMapping_NeHe Lesson 18"
%GL_WINDOWWIDTH = 640
%GL_WINDOWHEIGHT = 480
%GL_BITSPERPEL = 16
%GL_DEPTHBITS = 16
GLOBAL hDC AS LONG
GLOBAL TextureHandles() AS DWORD
GLOBAL LightAmbient() AS SINGLE
GLOBAL LightDiffuse() AS SINGLE
GLOBAL LightPosition() AS SINGLE
GLOBAL p1 AS LONG
GLOBAL p2 AS LONG
GLOBAL zoom AS SINGLE
GLOBAL nObject AS DWORD
GLOBAL quadratic AS DWORD
GLOBAL xrot AS SINGLE
GLOBAL yrot AS SINGLE
GLOBAL filter AS LONG
GLOBAL part1 AS LONG
GLOBAL part2 AS LONG
GLOBAL xspeed AS SINGLE
GLOBAL yspeed AS SINGLE
TYPE WNDCLASSEX
cbSize AS DWORD
STYLE AS DWORD
lpfnWndProc AS LONG
cbClsExtra AS LONG
cbWndExtra AS LONG
hInstance AS DWORD
hIcon AS DWORD
hCursor AS DWORD
hbrBackground AS DWORD
lpszMenuName AS ASCIIZ PTR
lpszClassName AS ASCIIZ PTR
hIconSm AS DWORD
END TYPE
' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
LOCAL hr AS LONG
LOCAL strTextureData AS STRING
LOCAL TextureWidth, TextureHeight AS LONG
DIM TextureHandles(2) AS DWORD
DIM LightAmbient(3) AS SINGLE
DIM LightDiffuse(3) AS SINGLE
DIM LightPosition(3) AS SINGLE
p1 = 0 : p2 = 1 : zoom = -5.0!
ARRAY ASSIGN LightAmbient() = 0.5!, 0.5!, 0.5!, 1.0!
ARRAY ASSIGN LightDiffuse() = 1.0!, 1.0!, 1.0!, 1.0!
ARRAY ASSIGN LightPosition() = 0.0!, 0.0!, 2.0!, 1.0!
' Load bitmap texture from disk
hr = GdiPlusLoadTexture("wall.bmp", TextureWidth, TextureHeight, strTextureData, %TRUE)
' Assign handles
glGenTextures 3, TextureHandles(0)
' Create Nearest Filtered Texture
glBindTexture %GL_TEXTURE_2D, TextureHandles(0)
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_NEAREST
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_NEAREST
glTexImage2D %GL_TEXTURE_2D, 0, 3, TextureWidth, TextureHeight, 0, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
' Create Linear Filtered Texture
glBindTexture %GL_TEXTURE_2D, TextureHandles(1)
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_LINEAR
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_LINEAR
glTexImage2D %GL_TEXTURE_2D, 0, 3, TextureWidth, TextureHeight, 0, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
' Create MipMapped Texture
glBindTexture %GL_TEXTURE_2D, TextureHandles(2)
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_LINEAR
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_LINEAR_MIPMAP_NEAREST
gluBuild2DMipmaps %GL_TEXTURE_2D, 3, TextureWidth, TextureHeight, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
' Enable texture mapping
glEnable %GL_TEXTURE_2D
' Select smooth shading
glShadeModel %GL_SMOOTH
' Specify clear values for the color buffers
glClearColor 0.0!, 0.0!, 0.0!, 0.0!
' Specify the clear value for the depth buffer
glClearDepth 1.0!
' The type of depth test to do
glDepthFunc %GL_LEQUAL
' Enables depth testing
glEnable %GL_DEPTH_TEST
' Really nice perspective calculations
glHint %GL_PERSPECTIVE_CORRECTION_HINT, %GL_NICEST
glLightfv %GL_LIGHT1, %GL_AMBIENT, LightAmbient(0)
glLightfv %GL_LIGHT1, %GL_DIFFUSE, LightDiffuse(0)
glLightfv %GL_LIGHT1, %GL_POSITION, LightPosition(0)
glEnable %GL_LIGHT1
quadratic = gluNewQuadric
gluQuadricNormals quadratic, %GLU_SMOOTH
gluQuadricTexture quadratic, %GL_TRUE
'glTexGeni(%GL_S, %GL_TEXTURE_GEN_MODE, %GL_SPHERE_MAP) ' %GL_EYE_LINEAR
'glTexGeni(%GL_T, %GL_TEXTURE_GEN_MODE, %GL_SPHERE_MAP) '%GL_EYE_LINEAR
END SUB
' =======================================================================================
' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Prevent divide by zero making height equal one
IF nHeight = 0 THEN nHeight = 1
' Reset the current viewport
glViewport 0, 0, nWidth, nHeight
' Select the projection matrix
glMatrixMode %GL_PROJECTION
' Reset the projection matrix
glLoadIdentity
' Calculate the aspect ratio of the window
gluPerspective 45.0!, nWidth / nHeight, 0.1!, 100.0!
' Select the model view matrix
glMatrixMode %GL_MODELVIEW
' Reset the model view matrix
glLoadIdentity
END SUB
' =======================================================================================
' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Clear the screen buffer
glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
' Reset the view
glLoadIdentity
glTranslatef 0.0!, 0.0!, zoom
glRotatef xrot, 1.0!, 0.0!, 0.0!
glRotatef yrot, 0.0!, 1.0!, 0.0!
glEnable(%GL_TEXTURE_GEN_S)
glEnable(%GL_TEXTURE_GEN_T)
glBindTexture %GL_TEXTURE_2D, TextureHandles(filter)
SELECT CASE nObject
CASE 0
glBegin %GL_QUADS
' Front face
glNormal3f 0.0!, 0.0!, 1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f -1.0!, -1.0!, 1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f 1.0!, -1.0!, 1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f 1.0!, 1.0!, 1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f -1.0!, 1.0!, 1.0!
' Back face
glNormal3f 0.0!, 0.0!, -1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f -1.0!, -1.0!, -1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f -1.0!, 1.0!, -1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f 1.0!, 1.0!, -1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f 1.0!, -1.0!, -1.0!
' Top face
glNormal3f 0.0!, 1.0!, 0.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f -1.0!, 1.0!, -1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f -1.0!, 1.0!, 1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f 1.0!, 1.0!, 1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f 1.0!, 1.0!, -1.0!
' Bottom face
glNormal3f 0.0!, -1.0!, 0.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f -1.0!, -1.0!, -1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f 1.0!, -1.0!, -1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f 1.0!, -1.0!, 1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f -1.0!, -1.0!, 1.0!
' Right face
glNormal3f 1.0!, 0.0!, 0.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f 1.0!, -1.0!, -1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f 1.0!, 1.0!, -1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f 1.0!, 1.0!, 1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f 1.0!, -1.0!, 1.0!
' Left face
glNormal3f -1.0!, 0.0!, 0.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f -1.0!, -1.0!, -1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f -1.0!, -1.0!, 1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f -1.0!, 1.0!, 1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f -1.0!, 1.0!, -1.0!
glEnd
CASE 1
' Center the cylinder
glTranslatef 0.0!, 0.0!, -1.5!
' A cylinder with a radius of 0.5 and a height of 2
gluCylinder quadratic, 1.0!, 1.0!, 3.0!, 32, 32
CASE 2
' Draw a disc (cd shape) with an inner radius of 0.5, and an outer radius of 2. plus a lot of segments ;)
gluDisk quadratic, 0.5!, 1.5!, 32, 32
CASE 3
' Draw a sphere with a radius of 1 and 16 longitude and 16 latitude segments
gluSphere quadratic, 1.3!, 32, 32
CASE 4
' Center the cone
glTranslatef 0.0!, 0.0!, -1.5!
' a cone with a bottom radius of .5 and a height of 2
gluCylinder quadratic, 1.0!, 0.0!, 3.0!, 32, 32
CASE 5
part1 = part1 + p1
part2 = part2 + p2
IF part1 > 359 THEN ' 360 Degrees
p1 = 0
part1 = 0
p2 = 1
part2 = 0
END IF
IF part2 > 359 THEN ' 360 Degrees
p1 = 1
p2 = 0
END IF
' A disk like the one before
gluPartialDisk quadratic, 0.5!, 1.5!, 32, 32, part1, part2 - part1
glDisable(%GL_TEXTURE_GEN_S)
glDisable(%GL_TEXTURE_GEN_T)
END SELECT
xrot = xrot + xspeed
yrot = yrot + yspeed
END SUB
' =======================================================================================
' =======================================================================================
' Cleanup
' =======================================================================================
SUB Cleanup (BYVAL hwnd AS DWORD)
' Delete the textures
glDeleteTextures(3, TextureHandles(0))
END SUB
' =======================================================================================
' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)
STATIC lp, fp, sp, light AS LONG
SELECT CASE AS LONG vKeyCode
CASE %VK_ESCAPE
' Quit if Esc key pressed
SendMessage hwnd, %WM_CLOSE, 0, 0
CASE %VK_L
IF ISTRUE bKeyDown AND ISFALSE lp THEN
lp = %TRUE
light = NOT light
IF ISFALSE light THEN
glDisable %GL_LIGHTING
ELSE
glEnable %GL_LIGHTING
END IF
END IF
IF ISFALSE bKeyDown THEN lp = %FALSE
CASE %VK_F
IF ISTRUE bKeyDown AND ISFALSE fp THEN
fp = %TRUE
filter = filter + 1
IF filter > 2 THEN filter = 0
END IF
IF ISFALSE bKeyDown THEN fp = %FALSE
CASE %VK_SPACE
IF ISTRUE bKeyDown AND ISFALSE sp THEN
sp = %TRUE
nObject = nObject + 1
IF nObject > 5 THEN nObject = 0
END IF
IF ISFALSE bKeyDown THEN sp = %FALSE
CASE %VK_PGUP
IF ISTRUE bKeyDown THEN zoom = zoom - 0.02!
CASE %VK_PGDN
IF ISTRUE bKeyDown THEN zoom = zoom + 0.02!
CASE %VK_LEFT
IF ISTRUE bKeyDown THEN yspeed = yspeed - 0.01!
CASE %VK_RIGHT
IF ISTRUE bKeyDown THEN yspeed = yspeed + 0.01!
CASE %VK_UP
IF ISTRUE bKeyDown THEN xspeed = xspeed - 0.01!
CASE %VK_DOWN
IF ISTRUE bKeyDown THEN xspeed = xspeed + 0.01!
END SELECT
END SUB
' =======================================================================================
' =======================================================================================
' Main
' =======================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL wcex AS WNDCLASSEX
LOCAL szClassName AS ASCIIZ * 256
LOCAL szCaption AS ASCIIZ * 256
LOCAL msg AS tagMSG
LOCAL rc AS RECT
LOCAL bDone AS LONG
LOCAL nLeft AS LONG
LOCAL nTop AS LONG
LOCAL nWidth AS LONG
LOCAL nHeight AS LONG
LOCAL dwStyle AS DWORD
LOCAL dwStyleEx AS DWORD
STATIC vKeyCode AS LONG
STATIC bKeyDown AS LONG
LOCAL t AS DOUBLE
LOCAL t0 AS DOUBLE
LOCAL fps AS DOUBLE
LOCAL nFrames AS LONG
LOCAL dm AS DEVMODE
LOCAL bFullScreen AS LONG
LOCAL lResult AS LONG
' Register the window class
szClassName = "PBOPENGL"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %NULL
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
wcex.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
RegisterClassEx wcex
' Ask the user which screen mode he prefers
lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _
"Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION)
SELECT CASE lResult
CASE %IDCANCEL : EXIT FUNCTION
CASE %IDYES : bFullScreen = %TRUE
CASE %IDNO : bFullScreen = %FALSE
END SELECT
' Window size
nWidth = %GL_WINDOWWIDTH
nHeight = %GL_WINDOWHEIGHT
IF bFullScreen THEN
' Change display settings
dm.dmSize = SIZEOF(dm)
dm.dmPelsWidth = nWidth
dm.dmPelsHeight = nHeight
dm.dmBitsPerPel = %GL_BITSPERPEL
dm.dmFields = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT
IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE
END IF
' Window caption
szCaption = $WindowCaption
' Window styles
IF ISFALSE bFullScreen THEN
dwStyle = %WS_OVERLAPPEDWINDOW
dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
ELSE
dwStyle = %WS_POPUP
dwStyleEx = %WS_EX_APPWINDOW
END IF
' Create the window
hwnd = CreateWindowEx( _
dwStyleEx, _
szClassName, _
szCaption, _
dwStyle, _
100, _ 'nLeft, _
100, _ 'nTop, _
nWidth, _
nHeight, _
%NULL, _
0, _
hInstance, _
BYVAL %NULL)
' Retrieve the coordinates of the window's client area
GetClientRect hwnd, rc
' Initialize the new OpenGl window
SetupScene hwnd, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop
' Show the window
ShowWindow hwnd, nCmdShow
UpdateWindow hwnd
DO UNTIL bDone
' Windows message pump
DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE)
IF msg.message = %WM_QUIT THEN
bDone = %TRUE
ELSE
IF msg.message = %WM_KEYDOWN THEN
vKeyCode = msg.wParam
bKeyDown = %TRUE
ELSEIF msg.message = %WM_KEYUP THEN
vKeyCode = msg.wParam
bKeyDown = %FALSE
END IF
TranslateMessage msg
DispatchMessage msg
END IF
LOOP
IF ISFALSE bFullScreen THEN
' Get time and mouse position
t = INT(TIMER)
' Calculate and display FPS (frames per second)
IF t > t0 OR nFrames = 0 THEN
fps = nFrames \ (t - t0)
wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps
SetWindowText hwnd, szCaption
t0 = t
nFrames = 0
END IF
nFrames = nFrames + 1
END IF
' Draw the scene
DrawScene hwnd, nWidth, nHeight
' Exchange the front and back buffers
SwapBuffers hDC
' Process the keystrokes
IF vKeyCode THEN
ProcessKeystrokes hwnd, vKeyCode, bKeyDown
vKeyCode = 0
END IF
LOOP
' Retore defaults
IF bFullScreen THEN
ChangeDisplaySettings BYVAL %NULL, 0
ShowCursor %TRUE
END IF
FUNCTION = msg.wParam
END FUNCTION
' =======================================================================================
' =======================================================================================
' Main window procedure
' =======================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL pf AS LONG
LOCAL pfd AS PIXELFORMATDESCRIPTOR
STATIC hRC AS LONG
SELECT CASE wMsg
CASE %WM_SYSCOMMAND
' Disable the Windows screensaver
IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION
' Close the window
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_CREATE
' Retrieve the device context handle
hDC = GetDC(hwnd)
' Fill the PIXELFORMATDESCRIPTOR structure
pfd.nSize = SIZEOF(PIXELFORMATDESCRIPTOR)
pfd.nVersion = 1
pfd.dwFlags = %PFD_DRAW_TO_WINDOW _
OR %PFD_SUPPORT_OPENGL _
OR %PFD_DOUBLEBUFFER
pfd.iPixelType = %PFD_TYPE_RGBA
pfd.cColorBits = %GL_BITSPERPEL
pfd.cRedBits = 0
pfd.cRedShift = 0
pfd.cGreenBits = 0
pfd.cGreenShift = 0
pfd.cBlueBits = 0
pfd.cBlueShift = 0
pfd.cAlphaBits = 0
pfd.cAlphaShift = 0
pfd.cAccumBits = 0
pfd.cAccumRedBits = 0
pfd.cAccumGreenBits = 0
pfd.cAccumBlueBits = 0
pfd.cAccumAlphaBits = 0
pfd.cDepthBits = %GL_DEPTHBITS
pfd.cStencilBits = 0
pfd.cAuxBuffers = 0
pfd.iLayerType = %PFD_MAIN_PLANE
pfd.bReserved = 0
pfd.dwLayerMask = 0
pfd.dwVisibleMask = 0
pfd.dwDamageMask = 0
' Find a matching pixel format
pf = ChoosePixelFormat(hDC, pfd)
IF ISFALSE pf THEN
MessageBox hwnd, "Can't find a suitable pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Set the pixel format
IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN
MessageBox hwnd, "Can't set the pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Create a new OpenGL rendering context
hRC = wglCreateContext(hDC)
IF ISFALSE hRC THEN
MessageBox hwnd, "Can't create an OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Make it current
IF ISFALSE wglMakeCurrent(hDC,hRC) THEN
MessageBox hwnd, "Can't activate the OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
EXIT FUNCTION
CASE %WM_DESTROY
' Clear resources
Cleanup hwnd
' Release the device and rendering contexts
wglMakeCurrent hDC, 0
' Make the rendering context no longer current
wglDeleteContext hRC
' Release the device context
ReleaseDC hwnd, hDC
' Post an WM_QUIT message
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_SIZE
ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
EXIT FUNCTION
END SELECT
' Call the default window procedure to process unhandled messages
FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
END FUNCTION
' =======================================================================================
see zip folder.
thanks. kind regards, frank
the problem seems to be "seamless texture" for mapping the sphere. Here's another example to show what I am meaning: Klick with mouse at cube or sphere and spin it. left sphere I haven't changed like nehe have built his example in original modus. I wanted to know why it's not possible to cover this sphere with perfect smooth texture (seamless). any ideas or hints are welcome.
'//-----------------------------------------------------------------------------
'// Name: ogl_multiple_vertex_arrays.cpp
'// Author: Kevin Harris
'// Last Modified: 02/01/05
'// Description: This sample demonstrates how to create 3D geometry with
'// OpenGL by loading vertex data into a multiple Vertex
'// Arrays.
'//-----------------------------------------------------------------------------
' Translated to PowerBASIC by José Roca, 2008.
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "GLU.INC"
#INCLUDE "GDIPUTILS.INC"
$WindowCaption = "cube_sphere texture mapping test2"
%GL_WINDOWWIDTH = 740
%GL_WINDOWHEIGHT = 580
%GL_BITSPERPEL = 16
%GL_DEPTHBITS = 16
GLOBAL hDC AS LONG
GLOBAL TextureHandle AS DWORD
GLOBAL rquad AS SINGLE
GLOBAL quadratic AS DWORD
GLOBAL N AS LONG
GLOBAL Xrot AS SINGLE
GLOBAL Yrot AS SINGLE
GLOBAL Zrot AS SINGLE
GLOBAL g_fSpinX AS SINGLE
GLOBAL g_fSpinY AS SINGLE
TYPE WNDCLASSEX
cbSize AS DWORD
STYLE AS DWORD
lpfnWndProc AS LONG
cbClsExtra AS LONG
cbWndExtra AS LONG
hInstance AS DWORD
hIcon AS DWORD
hCursor AS DWORD
hbrBackground AS DWORD
lpszMenuName AS ASCIIZ PTR
lpszClassName AS ASCIIZ PTR
hIconSm AS DWORD
END TYPE
TYPE Vertex
x AS SINGLE
y AS SINGLE
z AS SINGLE
END TYPE
GLOBAL g_cubeVertices () AS Vertex
TYPE tagColor
r AS SINGLE
g AS SINGLE
b AS SINGLE
END TYPE
GLOBAL g_cubeColors() AS tagColor
TYPE TexCoord
tu AS SINGLE
tv AS SINGLE
END TYPE
GLOBAL g_cubeTexCoords() AS TexCoord
' ========================================================================================
' Fills a Vertex structure
' ========================================================================================
MACRO FillVertex (v, x_, y_, z_)
v.x = x_ : v.y = y_ : v.z = z_
END MACRO
' ========================================================================================
' Fills a tagColor structure
' ========================================================================================
MACRO FillColor (c, r_, g_, b_)
c.r = r_ : c.g = g_ : c.b = b_
END MACRO
' ========================================================================================
' Fills a TexCoord structure
' ========================================================================================
MACRO FillTexCoord (t, tu_, tv_)
t.tu = tu_ : t.tv = tv_
END MACRO
' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
LOCAL hr AS LONG
LOCAL strTextureData AS STRING
LOCAL TextureWidth, TextureHeight AS LONG
DIM mat_specular(3) AS SINGLE
DIM mat_shininess(0) AS SINGLE
DIM light_position(3) AS SINGLE
DIM LightAmb(1) AS SINGLE
DIM LightDif(1) AS SINGLE
DIM LightPos(1) AS SINGLE
DIM g_cubeVertices(23)
FillVertex(g_cubeVertices( 0), -1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices( 1), 1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices( 2), 1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices( 3), -1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices( 4), -1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices( 5), -1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices( 6), 1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices( 7), 1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices( 8), -1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices( 9), -1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices(10), 1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices(11), 1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices(12), -1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices(13), 1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices(14), 1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices(15), -1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices(16), 1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices(17), 1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices(18), 1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices(19), 1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices(20), -1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices(21), -1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices(22), -1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices(23), -1.0!, 1.0!, -1.0!)
DIM g_cubeColors(23)
FillColor(g_cubeColors( 0), 1.0!, 0.0!, 0.0! )
FillColor(g_cubeColors( 1), 1.0!, 0.0!, 0.0! )
FillColor(g_cubeColors( 2), 1.0!, 0.0!, 0.0! )
FillColor(g_cubeColors( 3), 1.0!, 0.0!, 0.0! )
FillColor(g_cubeColors( 4), 0.0!, 1.0!, 0.0! )
FillColor(g_cubeColors( 5), 0.0!, 1.0!, 0.0! )
FillColor(g_cubeColors( 6), 0.0!, 1.0!, 0.0! )
FillColor(g_cubeColors( 7), 0.0!, 1.0!, 0.0! )
FillColor(g_cubeColors( 8), 0.0!, 0.0!, 1.0! )
FillColor(g_cubeColors( 9), 0.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(10), 0.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(11), 0.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(12), 1.0!, 1.0!, 0.0! )
FillColor(g_cubeColors(13), 1.0!, 1.0!, 0.0! )
FillColor(g_cubeColors(14), 1.0!, 1.0!, 0.0! )
FillColor(g_cubeColors(15), 1.0!, 1.0!, 0.0! )
FillColor(g_cubeColors(16), 1.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(17), 1.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(18), 1.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(19), 1.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(20), 0.0!, 1.0!, 1.0! )
FillColor(g_cubeColors(21), 0.0!, 1.0!, 1.0! )
FillColor(g_cubeColors(22), 0.0!, 1.0!, 1.0! )
FillColor(g_cubeColors(23), 0.0!, 1.0!, 1.0! )
DIM g_cubeTexCoords(23)
FillTexCoord(g_cubeTexCoords( 0), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords( 1), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords( 2), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 3), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 4), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords( 5), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 6), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 7), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords( 8), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 9), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(10), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(11), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(12), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(13), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(14), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(15), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(16), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(17), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(18), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(19), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(20), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(21), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(22), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(23), 0.0!, 1.0!)
glClearColor 0.0!, 0.0!, 0.3!, 0.0!
glEnable %GL_DEPTH_TEST
' Load bitmap texture from disk
hr = GdiPlusLoadTexture("meal.bmp", TextureWidth, TextureHeight, strTextureData, %TRUE)
' Assign an OpenGL handle to this texture
glGenTextures 1, TextureHandle
' Activate our newly created texture
glEnable %GL_TEXTURE_2D
glBindTexture %GL_TEXTURE_2D, TextureHandle
' Create the texture
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_LINEAR
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_LINEAR
glTexImage2D %GL_TEXTURE_2D, 0, %GL_RGBA, TextureWidth, TextureHeight, 0, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
ARRAY ASSIGN LightAmb() = 0.7, 0.7, 0.7, 1.0
ARRAY ASSIGN LightDif() = 1.0, 1.0, 1.0, 1.0
ARRAY ASSIGN LightPos() = 4.0, 4.0, 6.0, 1.0
ARRAY ASSIGN mat_specular() = 0.2, 0.6, 0.6, 1.0 '1.0, 1.0, 1.0, 1.0
ARRAY ASSIGN mat_shininess() = 50.0
ARRAY ASSIGN light_position() = 1.0, 1.0, 1.0, 0.0
glClearColor 0.0, 0.0, 0.0, 0.0
glShadeModel %GL_SMOOTH
glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
glLightfv(%GL_LIGHT0, %GL_AMBIENT, LightAmb(0) ) ' // SET The Ambient Lighting FOR Light0
glLightfv(%GL_LIGHT0, %GL_DIFFUSE, LightDif(0) ) ' // SET The Diffuse Lighting FOR Light0
glLightfv(%GL_LIGHT0, %GL_POSITION, LightPos(0)) ' // SET The Position FOR Light0
glTexGeni(%GL_S, %GL_TEXTURE_GEN_MODE, %GL_SPHERE_MAP) ' 'GL_OBJECT_LINEAR 'GL_SPHERE_MAP
glTexGeni(%GL_T, %GL_TEXTURE_GEN_MODE, %GL_SPHERE_MAP)
quadratic = gluNewQuadric ' Create a pointer to the quadric object
gluQuadricNormals quadratic, %GLU_SMOOTH ' Create smooth normals
gluQuadricTexture quadratic, %GL_TRUE ' Create texture coords
glEnable %GL_LIGHT0 ' Enable Light0 (Default GL Light)
END SUB
' =======================================================================================
' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Prevent divide by zero making height equal one
IF nHeight = 0 THEN nHeight = 1
' Reset the current viewport
glViewport 0, 0, nWidth, nHeight
' Select the projection matrix
glMatrixMode %GL_PROJECTION
' Reset the projection matrix
glLoadIdentity
' Calculate the aspect ratio of the window
gluPerspective 65.0!, nWidth / nHeight, 0.1!, 100.0!
' Select the model view matrix
glMatrixMode %GL_MODELVIEW
' Reset the model view matrix
glLoadIdentity
END SUB
' =======================================================================================
' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
STATIC fElpasedTime AS SINGLE
STATIC dCurrentTime AS DOUBLE
STATIC dLastTime AS DOUBLE
dCurrentTime = timeGetTime
fElpasedTime = (dCurrentTime - dLastTime) * 0.001
dLastTime = dCurrentTime
' Clear the screen buffer
glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
' Reset the view
glLoadIdentity
glTranslatef 2.5!, 0.0!, -5.0!
glRotatef(-g_fSpinY, 1.0!, 0.0!, 0.0!)
glRotatef(-g_fSpinX, 0.0!, 1.0!, 0.0!)
glBindTexture %GL_TEXTURE_2D, TextureHandle
glEnableClientState(%GL_VERTEX_ARRAY)
glEnableClientState(%GL_COLOR_ARRAY)
glEnableClientState(%GL_TEXTURE_COORD_ARRAY)
glVertexPointer(3, %GL_FLOAT, 0, g_cubeVertices(0))
glColorPointer(3, %GL_FLOAT, 0, g_cubeColors(0))
glTexCoordPointer(2, %GL_FLOAT, 0, g_cubeTexCoords(0))
glDrawArrays %GL_QUADS, 0, 24
glDisableClientState(%GL_VERTEX_ARRAY)
glDisableClientState(%GL_COLOR_ARRAY)
glDisableClientState(%GL_TEXTURE_COORD_ARRAY)
glColor4f(1.0, 1.0, 1.0, 0.4) '// Set Color To White With 40% Alpha
'glEnable(%GL_BLEND) '// Enable Blending
'glBlendFunc(%GL_SRC_ALPHA, %GL_ONE) ' '// Set Blending Mode To Mix Based On SRC Alpha
'%GL_ONE_MINUS_SRC_ALPHA
' glEnable(%GL_TEXTURE_GEN_S) ' // Enable Sphere Mapping
' glEnable(%GL_TEXTURE_GEN_T) ' // Enable Sphere Mapping
glLoadIdentity
glTranslatef -4.0 ,0.0 ,-8.0 '
glRotatef(-g_fSpinY, 1.0!, 0.0!, 0.0!)
glRotatef(-g_fSpinX, 0.0!, 1.0!, 0.0!)
glEnable %GL_LIGHTING
gluSphere quadratic,2.0,32,32
glDisable %GL_LIGHTING
' glDisable(%GL_TEXTURE_GEN_S)
' glDisable(%GL_TEXTURE_GEN_T)
glDisable(%GL_BLEND)
END SUB
' =======================================================================================
' =======================================================================================
' Cleanup
' =======================================================================================
SUB Cleanup (BYVAL hwnd AS DWORD)
' Delete the texture
IF TextureHandle THEN glDeleteTextures(1, TextureHandle)
END SUB
' =======================================================================================
' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)
SELECT CASE AS LONG vKeyCode
CASE %VK_ESCAPE
' Quit if Esc key pressed
SendMessage hwnd, %WM_CLOSE, 0, 0
END SELECT
END SUB
' =======================================================================================
' =======================================================================================
' Processes mouse clicks and movement
' Parameters:
' * hwnd = Window hande
' * wMsg = Windows message
' * wKeyState = Indicates whether various virtual keys are down.
' MK_CONTROL The CTRL key is down.
' MK_LBUTTON The left mouse button is down.
' MK_MBUTTON The middle mouse button is down.
' MK_RBUTTON The right mouse button is down.
' MK_SHIFT The SHIFT key is down.
' MK_XBUTTON1 Windows 2000/XP: The first X button is down.
' MK_XBUTTON2 Windows 2000/XP: The second X button is down.
' * x = x-coordinate of the cursor
' * y = y-coordinate of the cursor
' =======================================================================================
SUB ProcessMouse (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)
STATIC ptLastMousePosit AS POINTAPI
STATIC ptCurrentMousePosit AS POINTAPI
STATIC bMousing AS LONG
SELECT CASE wMsg
CASE %WM_LBUTTONDOWN
ptLastMousePosit.x = x
ptCurrentMousePosit.x = x
ptLastMousePosit.y = y
ptCurrentMousePosit.y = y
bMousing = %TRUE
CASE %WM_LBUTTONUP
bMousing = %FALSE
CASE %WM_MOUSEMOVE
ptCurrentMousePosit.x = x
ptCurrentMousePosit.y = y
IF bMousing THEN
g_fSpinX -= (ptCurrentMousePosit.x - ptLastMousePosit.x)
g_fSpinY -= (ptCurrentMousePosit.y - ptLastMousePosit.y)
END IF
ptLastMousePosit.x = ptCurrentMousePosit.x
ptLastMousePosit.y = ptCurrentMousePosit.y
END SELECT
END SUB
' =======================================================================================
' =======================================================================================
' Main
' =======================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL wcex AS WNDCLASSEX
LOCAL szClassName AS ASCIIZ * 256
LOCAL szCaption AS ASCIIZ * 256
LOCAL msg AS tagMSG
LOCAL rc AS RECT
LOCAL bDone AS LONG
LOCAL nLeft AS LONG
LOCAL nTop AS LONG
LOCAL nWidth AS LONG
LOCAL nHeight AS LONG
LOCAL dwStyle AS DWORD
LOCAL dwStyleEx AS DWORD
STATIC vKeyCode AS LONG
STATIC bKeyDown AS LONG
LOCAL t AS DOUBLE
LOCAL t0 AS DOUBLE
LOCAL fps AS DOUBLE
LOCAL nFrames AS LONG
LOCAL dm AS DEVMODE
LOCAL bFullScreen AS LONG
LOCAL lResult AS LONG
' Register the window class
szClassName = "PBOPENGL"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %NULL
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION)
wcex.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION)
RegisterClassEx wcex
' Ask the user which screen mode he prefers
lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _
"Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION)
SELECT CASE lResult
CASE %IDCANCEL : EXIT FUNCTION
CASE %IDYES : bFullScreen = %TRUE
CASE %IDNO : bFullScreen = %FALSE
END SELECT
' Window size
nWidth = %GL_WINDOWWIDTH
nHeight = %GL_WINDOWHEIGHT
IF bFullScreen THEN
' Change display settings
dm.dmSize = SIZEOF(dm)
dm.dmPelsWidth = nWidth
dm.dmPelsHeight = nHeight
dm.dmBitsPerPel = %GL_BITSPERPEL
dm.dmFields = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT
IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE
END IF
' Window caption
szCaption = $WindowCaption
' Window styles
IF ISFALSE bFullScreen THEN
dwStyle = %WS_OVERLAPPEDWINDOW
dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
ELSE
dwStyle = %WS_POPUP
dwStyleEx = %WS_EX_APPWINDOW
END IF
' Create the window
hwnd = CreateWindowEx( _
dwStyleEx, _
szClassName, _
szCaption, _
dwStyle, _
100, _ 'nLeft, _
100, _ 'nTop, _
nWidth, _
nHeight, _
%NULL, _
0, _
hInstance, _
BYVAL %NULL)
' Retrieve the coordinates of the window's client area
GetClientRect hwnd, rc
' Initialize the new OpenGl window
SetupScene hwnd, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop
' Show the window
ShowWindow hwnd, nCmdShow
UpdateWindow hwnd
DO UNTIL bDone
' Windows message pump
DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE)
IF msg.message = %WM_QUIT THEN
bDone = %TRUE
ELSE
IF msg.message = %WM_KEYDOWN THEN
vKeyCode = msg.wParam
bKeyDown = %TRUE
ELSEIF msg.message = %WM_KEYUP THEN
vKeyCode = msg.wParam
bKeyDown = %FALSE
END IF
TranslateMessage msg
DispatchMessage msg
END IF
LOOP
IF ISFALSE bFullScreen THEN
' Get time and mouse position
t = INT(TIMER)
' Calculate and display FPS (frames per second)
IF t > t0 OR nFrames = 0 THEN
fps = nFrames \ (t - t0)
wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps
SetWindowText hwnd, szCaption
t0 = t
nFrames = 0
END IF
nFrames = nFrames + 1
END IF
' Draw the scene
DrawScene hwnd, nWidth, nHeight
' Exchange the front and back buffers
SwapBuffers hDC
' Process the keystrokes
IF vKeyCode THEN
ProcessKeystrokes hwnd, vKeyCode, bKeyDown
vKeyCode = 0
END IF
LOOP
' Retore defaults
IF bFullScreen THEN
ChangeDisplaySettings BYVAL %NULL, 0
ShowCursor %TRUE
END IF
FUNCTION = msg.wParam
END FUNCTION
' =======================================================================================
' =======================================================================================
' Main window procedure
' =======================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL pf AS LONG
LOCAL pfd AS PIXELFORMATDESCRIPTOR
STATIC hRC AS LONG
SELECT CASE wMsg
CASE %WM_SYSCOMMAND
' Disable the Windows screensaver
IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION
' Close the window
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_CREATE
' Retrieve the device context handle
hDC = GetDC(hwnd)
' Fill the PIXELFORMATDESCRIPTOR structure
pfd.nSize = SIZEOF(PIXELFORMATDESCRIPTOR)
pfd.nVersion = 1
pfd.dwFlags = %PFD_DRAW_TO_WINDOW _
OR %PFD_SUPPORT_OPENGL _
OR %PFD_DOUBLEBUFFER
pfd.iPixelType = %PFD_TYPE_RGBA
pfd.cColorBits = %GL_BITSPERPEL
pfd.cRedBits = 0
pfd.cRedShift = 0
pfd.cGreenBits = 0
pfd.cGreenShift = 0
pfd.cBlueBits = 0
pfd.cBlueShift = 0
pfd.cAlphaBits = 0
pfd.cAlphaShift = 0
pfd.cAccumBits = 0
pfd.cAccumRedBits = 0
pfd.cAccumGreenBits = 0
pfd.cAccumBlueBits = 0
pfd.cAccumAlphaBits = 0
pfd.cDepthBits = %GL_DEPTHBITS
pfd.cStencilBits = 0
pfd.cAuxBuffers = 0
pfd.iLayerType = %PFD_MAIN_PLANE
pfd.bReserved = 0
pfd.dwLayerMask = 0
pfd.dwVisibleMask = 0
pfd.dwDamageMask = 0
' Find a matching pixel format
pf = ChoosePixelFormat(hDC, pfd)
IF ISFALSE pf THEN
MessageBox hwnd, "Can't find a suitable pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Set the pixel format
IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN
MessageBox hwnd, "Can't set the pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Create a new OpenGL rendering context
hRC = wglCreateContext(hDC)
IF ISFALSE hRC THEN
MessageBox hwnd, "Can't create an OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Make it current
IF ISFALSE wglMakeCurrent(hDC,hRC) THEN
MessageBox hwnd, "Can't activate the OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
EXIT FUNCTION
CASE %WM_DESTROY
' Clear resources
Cleanup hwnd
' Release the device and rendering contexts
wglMakeCurrent hDC, 0
' Make the rendering context no longer current
wglDeleteContext hRC
' Release the device context
ReleaseDC hwnd, hDC
' Post an WM_QUIT message
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_SIZE
ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
EXIT FUNCTION
CASE %WM_LBUTTONDOWN, %WM_LBUTTONUP, %WM_MOUSEMOVE
ProcessMouse hwnd, wMsg, wParam, LO(WORD, lParam), HI(WORD, lParam)
EXIT FUNCTION
END SELECT
' Call the default window procedure to process unhandled messages
FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
END FUNCTION
' =======================================================================================
for this example I have desactivated sphere Mapping
Quote' glEnable(%GL_TEXTURE_GEN_S) '// Enable Sphere Mapping
' glEnable(%GL_TEXTURE_GEN_T) '// Enable Sphere Mapping
glLoadIdentity
glTranslatef -4.0 ,0.0 ,-8.0 '
glRotatef(-g_fSpinY, 1.0!, 0.0!, 0.0!)
glRotatef(-g_fSpinX, 0.0!, 1.0!, 0.0!)
glEnable %GL_LIGHTING
gluSphere quadratic,2.0,32,32
glDisable %GL_LIGHTING
' glDisable(%GL_TEXTURE_GEN_S)
' glDisable(%GL_TEXTURE_GEN_T)
glDisable(%GL_BLEND)
openGL.org infos says:
http://www.opengl.org/resources/code/samples/sig99/advanced99/notes/node178.html
Quote11.2.1.2 Using a Sphere Map
To use sphere mapping in OpenGL, the following steps are performed:
28.
Bind the texture containing the sphere map.
29.
Set sphere mapping texture coordinate generation:
glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
30.
Enable texture coordinate generation and 2D texturing:
glEnable(GL_TEXTURE_GEN_S);
glEnable(GL_TEXTURE_GEN_T);
glEnable(GL_TEXTURE_2D);
31.
Draw the object, providing correct normals on a per-face or per-vertex basis.
frank
Frank
For spherical objects you must use rectangular textures, not a square one as you are doing.
I have some provided with the GDImage trial version.
...
thanks, patrice, but no success ;(
I've found "%GL_TEXTURE_RECTANGLE_ARB" in "glext.inc" equal for these rectangular texture for spheres and included it.
Quote'glEnable %GL_TEXTURE_RECTANGLE_ARB
glTexParameteri(%GL_TEXTURE_RECTANGLE_ARB, %GL_TEXTURE_WRAP_S, %GL_CLAMP )' %GL_REPEAT)
glTexParameteri(%GL_TEXTURE_RECTANGLE_ARB, %GL_TEXTURE_WRAP_T, %GL_CLAMP )'%GL_REPEAT)
glTexParameteri %GL_TEXTURE_RECTANGLE_ARB, %GL_TEXTURE_MAG_FILTER, %GL_NEAREST '%GL_LINEAR
glTexParameteri %GL_TEXTURE_RECTANGLE_ARB, %GL_TEXTURE_MIN_FILTER, %GL_NEAREST '%GL_LINEAR
glTexImage2D %GL_TEXTURE_RECTANGLE_ARB, 0, %GL_RGBA, TextureWidth, TextureHeight, 0, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
but something isn't perfect. the sphere doesn't rotate the texture as usual. What example I can study from "gdimage" examples where I can find code snippet about "%GL_TEXTURE_RECTANGLE_ARB" ? I didn't found anything about that sphere mapping one.
'//-----------------------------------------------------------------------------
'// Name: ogl_multiple_vertex_arrays.cpp
'// Author: Kevin Harris
'// Last Modified: 02/01/05
'// Description: This sample demonstrates how to create 3D geometry with
'// OpenGL by loading vertex data into a multiple Vertex
'// Arrays.
'//-----------------------------------------------------------------------------
' Translated to PowerBASIC by José Roca, 2008.
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "GLU.INC"
#INCLUDE "GLEXT.INC"
#INCLUDE "GDIPUTILS.INC"
$WindowCaption = "cube_sphere texture mapping test2b"
'%GL_TEXTURE_RECTANGLE_ARB = &H84F5???
'%GL_TEXTURE_BINDING_RECTANGLE_ARB = &H84F6???
'%GL_PROXY_TEXTURE_RECTANGLE_ARB = &H84F7???
'%GL_MAX_RECTANGLE_TEXTURE_SIZE_ARB = &H84F8???
%GL_WINDOWWIDTH = 740
%GL_WINDOWHEIGHT = 580
%GL_BITSPERPEL = 16
%GL_DEPTHBITS = 16
GLOBAL hDC AS LONG
GLOBAL TextureHandle AS DWORD
GLOBAL rquad AS SINGLE
GLOBAL quadratic AS DWORD
GLOBAL N AS LONG
GLOBAL Xrot AS SINGLE
GLOBAL Yrot AS SINGLE
GLOBAL Zrot AS SINGLE
GLOBAL g_fSpinX AS SINGLE
GLOBAL g_fSpinY AS SINGLE
TYPE WNDCLASSEX
cbSize AS DWORD
STYLE AS DWORD
lpfnWndProc AS LONG
cbClsExtra AS LONG
cbWndExtra AS LONG
hInstance AS DWORD
hIcon AS DWORD
hCursor AS DWORD
hbrBackground AS DWORD
lpszMenuName AS ASCIIZ PTR
lpszClassName AS ASCIIZ PTR
hIconSm AS DWORD
END TYPE
TYPE Vertex
x AS SINGLE
y AS SINGLE
z AS SINGLE
END TYPE
GLOBAL g_cubeVertices () AS Vertex
TYPE tagColor
r AS SINGLE
g AS SINGLE
b AS SINGLE
END TYPE
GLOBAL g_cubeColors() AS tagColor
TYPE TexCoord
tu AS SINGLE
tv AS SINGLE
END TYPE
GLOBAL g_cubeTexCoords() AS TexCoord
' ========================================================================================
' Fills a Vertex structure
' ========================================================================================
MACRO FillVertex (v, x_, y_, z_)
v.x = x_ : v.y = y_ : v.z = z_
END MACRO
' ========================================================================================
' Fills a tagColor structure
' ========================================================================================
MACRO FillColor (c, r_, g_, b_)
c.r = r_ : c.g = g_ : c.b = b_
END MACRO
' ========================================================================================
' Fills a TexCoord structure
' ========================================================================================
MACRO FillTexCoord (t, tu_, tv_)
t.tu = tu_ : t.tv = tv_
END MACRO
' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
LOCAL hr AS LONG
LOCAL strTextureData AS STRING
LOCAL TextureWidth, TextureHeight AS LONG
DIM mat_specular(3) AS SINGLE
DIM mat_shininess(0) AS SINGLE
DIM light_position(3) AS SINGLE
DIM LightAmb(1) AS SINGLE
DIM LightDif(1) AS SINGLE
DIM LightPos(1) AS SINGLE
DIM g_cubeVertices(23)
FillVertex(g_cubeVertices( 0), -1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices( 1), 1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices( 2), 1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices( 3), -1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices( 4), -1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices( 5), -1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices( 6), 1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices( 7), 1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices( 8), -1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices( 9), -1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices(10), 1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices(11), 1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices(12), -1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices(13), 1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices(14), 1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices(15), -1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices(16), 1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices(17), 1.0!, 1.0!, -1.0!)
FillVertex(g_cubeVertices(18), 1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices(19), 1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices(20), -1.0!, -1.0!, -1.0!)
FillVertex(g_cubeVertices(21), -1.0!, -1.0!, 1.0!)
FillVertex(g_cubeVertices(22), -1.0!, 1.0!, 1.0!)
FillVertex(g_cubeVertices(23), -1.0!, 1.0!, -1.0!)
DIM g_cubeColors(23)
FillColor(g_cubeColors( 0), 1.0!, 0.0!, 0.0! )
FillColor(g_cubeColors( 1), 1.0!, 0.0!, 0.0! )
FillColor(g_cubeColors( 2), 1.0!, 0.0!, 0.0! )
FillColor(g_cubeColors( 3), 1.0!, 0.0!, 0.0! )
FillColor(g_cubeColors( 4), 0.0!, 1.0!, 0.0! )
FillColor(g_cubeColors( 5), 0.0!, 1.0!, 0.0! )
FillColor(g_cubeColors( 6), 0.0!, 1.0!, 0.0! )
FillColor(g_cubeColors( 7), 0.0!, 1.0!, 0.0! )
FillColor(g_cubeColors( 8), 0.0!, 0.0!, 1.0! )
FillColor(g_cubeColors( 9), 0.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(10), 0.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(11), 0.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(12), 1.0!, 1.0!, 0.0! )
FillColor(g_cubeColors(13), 1.0!, 1.0!, 0.0! )
FillColor(g_cubeColors(14), 1.0!, 1.0!, 0.0! )
FillColor(g_cubeColors(15), 1.0!, 1.0!, 0.0! )
FillColor(g_cubeColors(16), 1.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(17), 1.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(18), 1.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(19), 1.0!, 0.0!, 1.0! )
FillColor(g_cubeColors(20), 0.0!, 1.0!, 1.0! )
FillColor(g_cubeColors(21), 0.0!, 1.0!, 1.0! )
FillColor(g_cubeColors(22), 0.0!, 1.0!, 1.0! )
FillColor(g_cubeColors(23), 0.0!, 1.0!, 1.0! )
DIM g_cubeTexCoords(23)
FillTexCoord(g_cubeTexCoords( 0), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords( 1), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords( 2), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 3), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 4), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords( 5), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 6), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 7), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords( 8), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords( 9), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(10), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(11), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(12), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(13), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(14), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(15), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(16), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(17), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(18), 0.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(19), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(20), 0.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(21), 1.0!, 0.0!)
FillTexCoord(g_cubeTexCoords(22), 1.0!, 1.0!)
FillTexCoord(g_cubeTexCoords(23), 0.0!, 1.0!)
glClearColor 0.0!, 0.0!, 0.3!, 0.0!
glEnable %GL_DEPTH_TEST
' Load bitmap texture from disk
hr = GdiPlusLoadTexture("meal.bmp", TextureWidth, TextureHeight, strTextureData, %TRUE)
' Assign an OpenGL handle to this texture
glGenTextures 1, TextureHandle
' Activate our newly created texture
glEnable %GL_TEXTURE_2D
'glEnable %GL_TEXTURE_RECTANGLE_ARB
glBindTexture %GL_TEXTURE_RECTANGLE_ARB, TextureHandle '%GL_TEXTURE_2D
glBindTexture %GL_TEXTURE_2D, TextureHandle
glTexParameteri(%GL_TEXTURE_2D, %GL_TEXTURE_WRAP_S, %GL_REPEAT )' 'GL_TEXTURE_2D
glTexParameteri(%GL_TEXTURE_2D, %GL_TEXTURE_WRAP_T, %GL_REPEAT )'
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_LINEAR '
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_LINEAR '
glTexImage2D %GL_TEXTURE_2D, 0, %GL_RGBA, TextureWidth, TextureHeight, 0, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
'glEnable %GL_TEXTURE_RECTANGLE_ARB
glTexParameteri(%GL_TEXTURE_RECTANGLE_ARB, %GL_TEXTURE_WRAP_S, %GL_CLAMP )' %GL_REPEAT)
glTexParameteri(%GL_TEXTURE_RECTANGLE_ARB, %GL_TEXTURE_WRAP_T, %GL_CLAMP )'%GL_REPEAT)
glTexParameteri %GL_TEXTURE_RECTANGLE_ARB, %GL_TEXTURE_MAG_FILTER, %GL_NEAREST '%GL_LINEAR
glTexParameteri %GL_TEXTURE_RECTANGLE_ARB, %GL_TEXTURE_MIN_FILTER, %GL_NEAREST '%GL_LINEAR
glTexImage2D %GL_TEXTURE_RECTANGLE_ARB, 0, %GL_RGBA, TextureWidth, TextureHeight, 0, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
ARRAY ASSIGN LightAmb() = 0.7, 0.7, 0.7, 1.0
ARRAY ASSIGN LightDif() = 1.0, 1.0, 1.0, 1.0
ARRAY ASSIGN LightPos() = 4.0, 4.0, 6.0, 1.0
ARRAY ASSIGN mat_specular() = 0.2, 0.6, 0.6, 1.0 '1.0, 1.0, 1.0, 1.0
ARRAY ASSIGN mat_shininess() = 50.0
ARRAY ASSIGN light_position() = 1.0, 1.0, 1.0, 0.0
glClearColor 0.0, 0.0, 0.0, 0.0
glShadeModel %GL_SMOOTH
glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
glLightfv(%GL_LIGHT0, %GL_AMBIENT, LightAmb(0) ) ' // SET The Ambient Lighting FOR Light0
glLightfv(%GL_LIGHT0, %GL_DIFFUSE, LightDif(0) ) ' // SET The Diffuse Lighting FOR Light0
glLightfv(%GL_LIGHT0, %GL_POSITION, LightPos(0)) ' // SET The Position FOR Light0
glTexGeni(%GL_S, %GL_TEXTURE_GEN_MODE, %GL_SPHERE_MAP) ' 'GL_OBJECT_LINEAR 'GL_SPHERE_MAP
glTexGeni(%GL_T, %GL_TEXTURE_GEN_MODE, %GL_SPHERE_MAP)
quadratic = gluNewQuadric ' Create a pointer to the quadric object
gluQuadricNormals quadratic, %GLU_SMOOTH ' Create smooth normals
gluQuadricTexture quadratic, %GL_TRUE ' Create texture coords
glEnable %GL_LIGHT0 ' Enable Light0 (Default GL Light)
END SUB
' =======================================================================================
' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Prevent divide by zero making height equal one
IF nHeight = 0 THEN nHeight = 1
' Reset the current viewport
glViewport 0, 0, nWidth, nHeight
' Select the projection matrix
glMatrixMode %GL_PROJECTION
' Reset the projection matrix
glLoadIdentity
' Calculate the aspect ratio of the window
gluPerspective 65.0!, nWidth / nHeight, 0.1!, 100.0!
' Select the model view matrix
glMatrixMode %GL_MODELVIEW
' Reset the model view matrix
glLoadIdentity
END SUB
' =======================================================================================
' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
STATIC fElpasedTime AS SINGLE
STATIC dCurrentTime AS DOUBLE
STATIC dLastTime AS DOUBLE
dCurrentTime = timeGetTime
fElpasedTime = (dCurrentTime - dLastTime) * 0.001
dLastTime = dCurrentTime
' Clear the screen buffer
glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
' Reset the view
glLoadIdentity
glTranslatef 2.5!, 0.0!, -5.0!
glRotatef(-g_fSpinY, 1.0!, 0.0!, 0.0!)
glRotatef(-g_fSpinX, 0.0!, 1.0!, 0.0!)
glTexEnvf(%GL_TEXTURE_ENV, %GL_TEXTURE_ENV_MODE, %GL_DECAL)
glBindTexture %GL_TEXTURE_2D, TextureHandle
glBindTexture %GL_TEXTURE_RECTANGLE_ARB, TextureHandle
glEnableClientState(%GL_VERTEX_ARRAY)
glEnableClientState(%GL_COLOR_ARRAY)
glEnableClientState(%GL_TEXTURE_COORD_ARRAY)
glVertexPointer(3, %GL_FLOAT, 0, g_cubeVertices(0))
glColorPointer(3, %GL_FLOAT, 0, g_cubeColors(0))
glTexCoordPointer(2, %GL_FLOAT, 0, g_cubeTexCoords(0))
glDrawArrays %GL_QUADS, 0, 24
glDisableClientState(%GL_VERTEX_ARRAY)
glDisableClientState(%GL_COLOR_ARRAY)
glDisableClientState(%GL_TEXTURE_COORD_ARRAY)
glColor4f(1.0, 1.0, 1.0, 0.4) '// Set Color To White With 40% Alpha
'glEnable(%GL_BLEND) '// Enable Blending
'glBlendFunc(%GL_SRC_ALPHA, %GL_ONE) ' '// Set Blending Mode To Mix Based On SRC Alpha
'%GL_ONE_MINUS_SRC_ALPHA
glEnable(%GL_TEXTURE_GEN_S) ' // Enable Sphere Mapping
glEnable(%GL_TEXTURE_GEN_T) ' // Enable Sphere Mapping
glLoadIdentity
glTexEnvf(%GL_TEXTURE_ENV, %GL_TEXTURE_ENV_MODE, %GL_DECAL)
'glBindTexture %GL_TEXTURE_2D, TextureHandle
glBindTexture %GL_TEXTURE_RECTANGLE_ARB, TextureHandle
glTranslatef -4.0 ,0.0 ,-8.0 '
glRotatef(-g_fSpinY, 1.0!, 0.0!, 0.0!)
glRotatef(-g_fSpinX, 0.0!, 1.0!, 0.0!)
glEnable %GL_LIGHTING
CALL gluQuadricNormals(quadratic, %GLU_SMOOTH) ' Create Smooth Normals
CALL gluQuadricTexture(quadratic, %GL_TRUE) ' Create Texture Coords
gluSphere (quadratic,2.0,32,32)
'CALL gluSphere(quadratic, 1.5, 48, 48) ' 32, 32)
glDisable %GL_LIGHTING
'gluDeleteQuadric(quadratic)
glDisable(%GL_TEXTURE_GEN_S)
glDisable(%GL_TEXTURE_GEN_T)
'glDisable(%GL_BLEND)
END SUB
' =======================================================================================
' =======================================================================================
' Cleanup
' =======================================================================================
SUB Cleanup (BYVAL hwnd AS DWORD)
' Delete the texture
IF TextureHandle THEN glDeleteTextures(1, TextureHandle)
END SUB
' =======================================================================================
' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)
SELECT CASE AS LONG vKeyCode
CASE %VK_ESCAPE
' Quit if Esc key pressed
SendMessage hwnd, %WM_CLOSE, 0, 0
END SELECT
END SUB
' =======================================================================================
' =======================================================================================
' Processes mouse clicks and movement
' Parameters:
' * hwnd = Window hande
' * wMsg = Windows message
' * wKeyState = Indicates whether various virtual keys are down.
' MK_CONTROL The CTRL key is down.
' MK_LBUTTON The left mouse button is down.
' MK_MBUTTON The middle mouse button is down.
' MK_RBUTTON The right mouse button is down.
' MK_SHIFT The SHIFT key is down.
' MK_XBUTTON1 Windows 2000/XP: The first X button is down.
' MK_XBUTTON2 Windows 2000/XP: The second X button is down.
' * x = x-coordinate of the cursor
' * y = y-coordinate of the cursor
' =======================================================================================
SUB ProcessMouse (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)
STATIC ptLastMousePosit AS POINTAPI
STATIC ptCurrentMousePosit AS POINTAPI
STATIC bMousing AS LONG
SELECT CASE wMsg
CASE %WM_LBUTTONDOWN
ptLastMousePosit.x = x
ptCurrentMousePosit.x = x
ptLastMousePosit.y = y
ptCurrentMousePosit.y = y
bMousing = %TRUE
CASE %WM_LBUTTONUP
bMousing = %FALSE
CASE %WM_MOUSEMOVE
ptCurrentMousePosit.x = x
ptCurrentMousePosit.y = y
IF bMousing THEN
g_fSpinX -= (ptCurrentMousePosit.x - ptLastMousePosit.x)
g_fSpinY -= (ptCurrentMousePosit.y - ptLastMousePosit.y)
END IF
ptLastMousePosit.x = ptCurrentMousePosit.x
ptLastMousePosit.y = ptCurrentMousePosit.y
END SELECT
END SUB
' =======================================================================================
' =======================================================================================
' Main
' =======================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL wcex AS WNDCLASSEX
LOCAL szClassName AS ASCIIZ * 256
LOCAL szCaption AS ASCIIZ * 256
LOCAL msg AS tagMSG
LOCAL rc AS RECT
LOCAL bDone AS LONG
LOCAL nLeft AS LONG
LOCAL nTop AS LONG
LOCAL nWidth AS LONG
LOCAL nHeight AS LONG
LOCAL dwStyle AS DWORD
LOCAL dwStyleEx AS DWORD
STATIC vKeyCode AS LONG
STATIC bKeyDown AS LONG
LOCAL t AS DOUBLE
LOCAL t0 AS DOUBLE
LOCAL fps AS DOUBLE
LOCAL nFrames AS LONG
LOCAL dm AS DEVMODE
LOCAL bFullScreen AS LONG
LOCAL lResult AS LONG
' Register the window class
szClassName = "PBOPENGL"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %NULL
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION)
wcex.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION)
RegisterClassEx wcex
' Ask the user which screen mode he prefers
lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _
"Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION)
SELECT CASE lResult
CASE %IDCANCEL : EXIT FUNCTION
CASE %IDYES : bFullScreen = %TRUE
CASE %IDNO : bFullScreen = %FALSE
END SELECT
' Window size
nWidth = %GL_WINDOWWIDTH
nHeight = %GL_WINDOWHEIGHT
IF bFullScreen THEN
' Change display settings
dm.dmSize = SIZEOF(dm)
dm.dmPelsWidth = nWidth
dm.dmPelsHeight = nHeight
dm.dmBitsPerPel = %GL_BITSPERPEL
dm.dmFields = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT
IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE
END IF
' Window caption
szCaption = $WindowCaption
' Window styles
IF ISFALSE bFullScreen THEN
dwStyle = %WS_OVERLAPPEDWINDOW
dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
ELSE
dwStyle = %WS_POPUP
dwStyleEx = %WS_EX_APPWINDOW
END IF
' Create the window
hwnd = CreateWindowEx( _
dwStyleEx, _
szClassName, _
szCaption, _
dwStyle, _
100, _ 'nLeft, _
100, _ 'nTop, _
nWidth, _
nHeight, _
%NULL, _
0, _
hInstance, _
BYVAL %NULL)
' Retrieve the coordinates of the window's client area
GetClientRect hwnd, rc
' Initialize the new OpenGl window
SetupScene hwnd, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop
' Show the window
ShowWindow hwnd, nCmdShow
UpdateWindow hwnd
DO UNTIL bDone
' Windows message pump
DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE)
IF msg.message = %WM_QUIT THEN
bDone = %TRUE
ELSE
IF msg.message = %WM_KEYDOWN THEN
vKeyCode = msg.wParam
bKeyDown = %TRUE
ELSEIF msg.message = %WM_KEYUP THEN
vKeyCode = msg.wParam
bKeyDown = %FALSE
END IF
TranslateMessage msg
DispatchMessage msg
END IF
LOOP
IF ISFALSE bFullScreen THEN
' Get time and mouse position
t = INT(TIMER)
' Calculate and display FPS (frames per second)
IF t > t0 OR nFrames = 0 THEN
fps = nFrames \ (t - t0)
wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps
SetWindowText hwnd, szCaption
t0 = t
nFrames = 0
END IF
nFrames = nFrames + 1
END IF
' Draw the scene
DrawScene hwnd, nWidth, nHeight
' Exchange the front and back buffers
SwapBuffers hDC
' Process the keystrokes
IF vKeyCode THEN
ProcessKeystrokes hwnd, vKeyCode, bKeyDown
vKeyCode = 0
END IF
LOOP
' Retore defaults
IF bFullScreen THEN
ChangeDisplaySettings BYVAL %NULL, 0
ShowCursor %TRUE
END IF
FUNCTION = msg.wParam
END FUNCTION
' =======================================================================================
' =======================================================================================
' Main window procedure
' =======================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL pf AS LONG
LOCAL pfd AS PIXELFORMATDESCRIPTOR
STATIC hRC AS LONG
SELECT CASE wMsg
CASE %WM_SYSCOMMAND
' Disable the Windows screensaver
IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION
' Close the window
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_CREATE
' Retrieve the device context handle
hDC = GetDC(hwnd)
' Fill the PIXELFORMATDESCRIPTOR structure
pfd.nSize = SIZEOF(PIXELFORMATDESCRIPTOR)
pfd.nVersion = 1
pfd.dwFlags = %PFD_DRAW_TO_WINDOW _
OR %PFD_SUPPORT_OPENGL _
OR %PFD_DOUBLEBUFFER
pfd.iPixelType = %PFD_TYPE_RGBA
pfd.cColorBits = %GL_BITSPERPEL
pfd.cRedBits = 0
pfd.cRedShift = 0
pfd.cGreenBits = 0
pfd.cGreenShift = 0
pfd.cBlueBits = 0
pfd.cBlueShift = 0
pfd.cAlphaBits = 0
pfd.cAlphaShift = 0
pfd.cAccumBits = 0
pfd.cAccumRedBits = 0
pfd.cAccumGreenBits = 0
pfd.cAccumBlueBits = 0
pfd.cAccumAlphaBits = 0
pfd.cDepthBits = %GL_DEPTHBITS
pfd.cStencilBits = 0
pfd.cAuxBuffers = 0
pfd.iLayerType = %PFD_MAIN_PLANE
pfd.bReserved = 0
pfd.dwLayerMask = 0
pfd.dwVisibleMask = 0
pfd.dwDamageMask = 0
' Find a matching pixel format
pf = ChoosePixelFormat(hDC, pfd)
IF ISFALSE pf THEN
MessageBox hwnd, "Can't find a suitable pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Set the pixel format
IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN
MessageBox hwnd, "Can't set the pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Create a new OpenGL rendering context
hRC = wglCreateContext(hDC)
IF ISFALSE hRC THEN
MessageBox hwnd, "Can't create an OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Make it current
IF ISFALSE wglMakeCurrent(hDC,hRC) THEN
MessageBox hwnd, "Can't activate the OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
EXIT FUNCTION
CASE %WM_DESTROY
' Clear resources
Cleanup hwnd
' Release the device and rendering contexts
wglMakeCurrent hDC, 0
' Make the rendering context no longer current
wglDeleteContext hRC
' Release the device context
ReleaseDC hwnd, hDC
' Post an WM_QUIT message
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_SIZE
ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
EXIT FUNCTION
CASE %WM_LBUTTONDOWN, %WM_LBUTTONUP, %WM_MOUSEMOVE
ProcessMouse hwnd, wMsg, wParam, LO(WORD, lParam), HI(WORD, lParam)
EXIT FUNCTION
END SELECT
' Call the default window procedure to process unhandled messages
FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
END FUNCTION
' =======================================================================================
do you have any other idea?
regards, frank
No need to use GL_TEXTURE_RECTANGLE_ARB
Just use a rectangular texture, like the one attached to this post.
...
hello. I am glad, I've found the way for texturing with simple nehe7 (added a sphere) example with cube and sphere :) here's the correct example with seamless texture and smooth sphere primitive:
(use arrows for rotation: up, down, left, right)
'----------------> texture example for cube and sphere by frank brübach, 15.sept.2011 :)
'---------------------------------------------------------------------------------------->
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "GLU.INC"
#INCLUDE "GDIPLUS.INC"
#INCLUDE "GDIPUTILS.INC"
$WindowCaption = "modified_NeHe Lesson 07 + two textured Primitives :)"
%GL_WINDOWWIDTH = 640
%GL_WINDOWHEIGHT = 480
%GL_BITSPERPEL = 16
%GL_DEPTHBITS = 16
GLOBAL hDC AS LONG
GLOBAL TextureHandles() AS DWORD
GLOBAL xrot AS SINGLE
GLOBAL yrot AS SINGLE
GLOBAL zoom AS SINGLE
GLOBAL filter AS LONG
GLOBAL xspeed AS SINGLE
GLOBAL yspeed AS SINGLE
GLOBAL quadratic AS DWORD
TYPE WNDCLASSEX
cbSize AS DWORD
STYLE AS DWORD
lpfnWndProc AS LONG
cbClsExtra AS LONG
cbWndExtra AS LONG
hInstance AS DWORD
hIcon AS DWORD
hCursor AS DWORD
hbrBackground AS DWORD
lpszMenuName AS ASCIIZ PTR
lpszClassName AS ASCIIZ PTR
hIconSm AS DWORD
END TYPE
' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
LOCAL hr AS LONG
LOCAL strTextureData AS STRING
LOCAL TextureWidth, TextureHeight AS LONG
DIM LightAmbient(3) AS SINGLE
DIM LightDiffuse(3) AS SINGLE
DIM LightPosition(3) AS SINGLE
REDIM TextureHandles(2) AS DWORD
' Load bitmap texture from disk
hr = GdiPlusLoadTexture("ball.bmp", TextureWidth, TextureHeight, strTextureData, %TRUE) 'crate
' Assign an OpenGL handle to this texture
glGenTextures 3, TextureHandles(0)
' Activate our newly created texture
glEnable %GL_TEXTURE_2D
' Create Nearest Filtered Texture
glBindTexture %GL_TEXTURE_2D, TextureHandles(0)
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_NEAREST
glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_NEAREST
glTexImage2D %GL_TEXTURE_2D, 0, 3, TextureWidth, TextureHeight, 0, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
' Create Linear Filtered Texture
glBindTexture %GL_TEXTURE_2D, TextureHandles(1)
glTexParameteri %GL_TEXTURE_2D,%GL_TEXTURE_MAG_FILTER,%GL_LINEAR
glTexParameteri %GL_TEXTURE_2D,%GL_TEXTURE_MIN_FILTER,%GL_LINEAR
glTexImage2D %GL_TEXTURE_2D, 0, 3, TextureWidth, TextureHeight, 0, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
' Create MipMapped Texture
glBindTexture %GL_TEXTURE_2D, TextureHandles(2)
glTexParameteri %GL_TEXTURE_2D,%GL_TEXTURE_MAG_FILTER,%GL_LINEAR
glTexParameteri %GL_TEXTURE_2D,%GL_TEXTURE_MIN_FILTER,%GL_LINEAR_MIPMAP_NEAREST
gluBuild2DMipmaps %GL_TEXTURE_2D, 3, TextureWidth, TextureHeight, _
%GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)
glEnable %GL_TEXTURE_2D
' Specify clear values for the color buffers
glClearColor 0.0!, 0.0!, 0.0!, 0.0!
' Specify the clear value for the depth buffer
glClearDepth 1.0!
' Specify the value used for depth-buffer comparisons
glDepthFunc %GL_LESS
' Enable depth comparisons and update the depth buffer
glEnable %GL_DEPTH_TEST
' Select smooth shading
glShadeModel %GL_SMOOTH
ARRAY ASSIGN LightAmbient() = 0.5!, 0.5!, 0.5!, 1.0!
ARRAY ASSIGN LightDiffuse() = 1.0!, 1.0!, 1.0!, 1.0!
ARRAY ASSIGN LightPosition() = 0.0!, 0.0!, 2.0!, 1.0!
glLightfv %GL_LIGHT1, %GL_AMBIENT, LightAmbient(0)
glLightfv %GL_LIGHT1, %GL_DIFFUSE, LightDiffuse(0)
glLightfv %GL_LIGHT1, %GL_POSITION, LightPosition(0)
glEnable %GL_LIGHT1
zoom = -5.0
END SUB
' =======================================================================================
' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Prevent divide by zero making height equal one
IF nHeight = 0 THEN nHeight = 1
' Reset the current viewport
glViewport 0, 0, nWidth, nHeight
' Select the projection matrix
glMatrixMode %GL_PROJECTION
' Reset the projection matrix
glLoadIdentity
' Calculate the aspect ratio of the window
gluPerspective 65.0!, nWidth / nHeight, 0.1!, 100.0!
' Select the model view matrix
glMatrixMode %GL_MODELVIEW
' Reset the model view matrix
glLoadIdentity
END SUB
' =======================================================================================
' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Clear the screen buffer
glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
' Reset the view
glLoadIdentity
glTranslatef 3.0!, 0.0!, zoom
glRotatef xrot, 1.0!, 0.0!, 0.0!
glRotatef yrot, 0.0!, 1.0!, 0.0!
glBindTexture %GL_TEXTURE_2D, TextureHandles(filter)
glEnable %GL_LIGHTING
'---------------------------------> BALL/SPHERE TEXTURING ------------------------------->
CALL glPushMatrix()
'Draw sphere/Ball
quadratic = gluNewQuadric()
IF quadratic THEN
CALL gluQuadricNormals(quadratic, %GLU_SMOOTH)
CALL gluQuadricTexture(quadratic, %GL_TRUE)
CALL gluSphere(quadratic, 2.0, 48, 48) ' 32, 32)
CALL gluDeleteQuadric(quadratic)
END IF
CALL glPopMatrix()
'---------------------------------> BALL/SPHERE TEXTURING ------------------------------->
glDisable %GL_LIGHTING
glLoadIdentity
glTranslatef -3.0!, 0.0!, zoom
glRotatef xrot, 1.0!, 0.0!, 0.0!
glRotatef yrot, 0.0!, 1.0!, 0.0!
glBegin %GL_QUADS
' Front Face
glNormal3f 0.0!, 0.0!, 1.0
glTexCoord2f 0.0!, 0.0! : glVertex3f -1.0!, -1.0!, 1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f 1.0!, -1.0!, 1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f 1.0!, 1.0!, 1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f -1.0!, 1.0!, 1.0!
' Back Face
glNormal3f 0.0!, 0.0!, -1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f -1.0!, -1.0!, -1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f -1.0!, 1.0!, -1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f 1.0!, 1.0!, -1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f 1.0!, -1.0!, -1.0!
' Top Face
glNormal3f 0.0!, 1.0!, 0.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f -1.0!, 1.0!, -1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f -1.0!, 1.0!, 1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f 1.0!, 1.0!, 1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f 1.0!, 1.0!, -1.0!
' Bottom Face
glNormal3f 0.0!,-1.0!, 0.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f -1.0!, -1.0!, -1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f 1.0!, -1.0!, -1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f 1.0!, -1.0!, 1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f -1.0!, -1.0!, 1.0!
' Right face
glNormal3f 1.0!, 0.0!, 0.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f 1.0!, -1.0!, -1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f 1.0!, 1.0!, -1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f 1.0!, 1.0!, 1.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f 1.0!, -1.0!, 1.0!
' Left Face
glNormal3f -1.0!, 0.0!, 0.0!
glTexCoord2f 0.0!, 0.0! : glVertex3f -1.0!, -1.0!, -1.0!
glTexCoord2f 1.0!, 0.0! : glVertex3f -1.0!, -1.0!, 1.0!
glTexCoord2f 1.0!, 1.0! : glVertex3f -1.0!, 1.0!, 1.0!
glTexCoord2f 0.0!, 1.0! : glVertex3f -1.0!, 1.0!, -1.0!
glEnd
xrot = xrot + xspeed
yrot = yrot + yspeed
END SUB
' =======================================================================================
' =======================================================================================
' Cleanup
' =======================================================================================
SUB Cleanup (BYVAL hwnd AS DWORD)
' Delete the texture
glDeleteTextures(3, TextureHandles(0))
END SUB
' =======================================================================================
' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)
STATIC lp, fp, light AS LONG
SELECT CASE AS LONG vKeyCode
CASE %VK_ESCAPE
' Quit if Esc key pressed
SendMessage hwnd, %WM_CLOSE, 0, 0
CASE %VK_L
IF ISTRUE bKeyDown AND ISFALSE lp THEN
lp = %TRUE
light = NOT light
IF ISFALSE light THEN
glDisable %GL_LIGHTING
ELSE
glEnable %GL_LIGHTING
END IF
END IF
IF ISFALSE bKeyDown THEN lp = %FALSE
CASE %VK_F
IF ISTRUE bKeyDown AND ISFALSE fp THEN
fp = %TRUE
filter = filter + 1
IF filter > 2 THEN filter = 0
END IF
IF ISFALSE bKeyDown THEN fp = %FALSE
CASE %VK_PGUP
IF ISTRUE bKeyDown THEN zoom = zoom - 0.02!
CASE %VK_PGDN
IF ISTRUE bKeyDown THEN zoom = zoom + 0.02!
CASE %VK_UP
IF ISTRUE bKeyDown THEN xspeed = xspeed - 0.01!
CASE %VK_DOWN
IF ISTRUE bKeyDown THEN xspeed = xspeed + 0.01!
CASE %VK_LEFT
IF ISTRUE bKeyDown THEN yspeed = yspeed - 0.01!
CASE %VK_RIGHT
IF ISTRUE bKeyDown THEN yspeed = yspeed + 0.01!
END SELECT
END SUB
' =======================================================================================
' =======================================================================================
' Main
' =======================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL wcex AS WNDCLASSEX
LOCAL szClassName AS ASCIIZ * 256
LOCAL szCaption AS ASCIIZ * 256
LOCAL msg AS tagMSG
LOCAL rc AS RECT
LOCAL bDone AS LONG
LOCAL nLeft AS LONG
LOCAL nTop AS LONG
LOCAL nWidth AS LONG
LOCAL nHeight AS LONG
LOCAL dwStyle AS DWORD
LOCAL dwStyleEx AS DWORD
STATIC vKeyCode AS LONG
STATIC bKeyDown AS LONG
LOCAL t AS DOUBLE
LOCAL t0 AS DOUBLE
LOCAL fps AS DOUBLE
LOCAL nFrames AS LONG
LOCAL dm AS DEVMODE
LOCAL bFullScreen AS LONG
LOCAL lResult AS LONG
' Register the window class
szClassName = "PBOPENGL"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %NULL
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
wcex.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
RegisterClassEx wcex
' Ask the user which screen mode he prefers
lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _
"Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION)
SELECT CASE lResult
CASE %IDCANCEL : EXIT FUNCTION
CASE %IDYES : bFullScreen = %TRUE
CASE %IDNO : bFullScreen = %FALSE
END SELECT
' Window size
nWidth = %GL_WINDOWWIDTH
nHeight = %GL_WINDOWHEIGHT
IF bFullScreen THEN
' Change display settings
dm.dmSize = SIZEOF(dm)
dm.dmPelsWidth = nWidth
dm.dmPelsHeight = nHeight
dm.dmBitsPerPel = %GL_BITSPERPEL
dm.dmFields = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT
IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE
END IF
' Window caption
szCaption = $WindowCaption
' Window styles
IF ISFALSE bFullScreen THEN
dwStyle = %WS_OVERLAPPEDWINDOW
dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
ELSE
dwStyle = %WS_POPUP
dwStyleEx = %WS_EX_APPWINDOW
END IF
' Create the window
hwnd = CreateWindowEx( _
dwStyleEx, _
szClassName, _
szCaption, _
dwStyle, _
100, _ 'nLeft, _
100, _ 'nTop, _
nWidth, _
nHeight, _
%NULL, _
0, _
hInstance, _
BYVAL %NULL)
' Retrieve the coordinates of the window's client area
GetClientRect hwnd, rc
' Initialize the new OpenGl window
SetupScene hwnd, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop
' Show the window
ShowWindow hwnd, nCmdShow
UpdateWindow hwnd
DO UNTIL bDone
' Windows message pump
DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE)
IF msg.message = %WM_QUIT THEN
bDone = %TRUE
ELSE
IF msg.message = %WM_KEYDOWN THEN
vKeyCode = msg.wParam
bKeyDown = %TRUE
ELSEIF msg.message = %WM_KEYUP THEN
vKeyCode = msg.wParam
bKeyDown = %FALSE
END IF
TranslateMessage msg
DispatchMessage msg
END IF
LOOP
IF ISFALSE bFullScreen THEN
' Get time and mouse position
t = INT(TIMER)
' Calculate and display FPS (frames per second)
IF t > t0 OR nFrames = 0 THEN
fps = nFrames \ (t - t0)
wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps
SetWindowText hwnd, szCaption
t0 = t
nFrames = 0
END IF
nFrames = nFrames + 1
END IF
' Draw the scene
DrawScene hwnd, nWidth, nHeight
' Exchange the front and back buffers
SwapBuffers hDC
' Process the keystrokes
IF vKeyCode THEN
ProcessKeystrokes hwnd, vKeyCode, bKeyDown
vKeyCode = 0
END IF
LOOP
' Retore defaults
IF bFullScreen THEN
ChangeDisplaySettings BYVAL %NULL, 0
ShowCursor %TRUE
END IF
FUNCTION = msg.wParam
END FUNCTION
' =======================================================================================
' =======================================================================================
' Main window procedure
' =======================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL pf AS LONG
LOCAL pfd AS PIXELFORMATDESCRIPTOR
STATIC hRC AS LONG
SELECT CASE wMsg
CASE %WM_SYSCOMMAND
' Disable the Windows screensaver
IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION
' Close the window
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_CREATE
' Retrieve the device context handle
hDC = GetDC(hwnd)
' Fill the PIXELFORMATDESCRIPTOR structure
pfd.nSize = SIZEOF(PIXELFORMATDESCRIPTOR)
pfd.nVersion = 1
pfd.dwFlags = %PFD_DRAW_TO_WINDOW _
OR %PFD_SUPPORT_OPENGL _
OR %PFD_DOUBLEBUFFER
pfd.iPixelType = %PFD_TYPE_RGBA
pfd.cColorBits = %GL_BITSPERPEL
pfd.cRedBits = 0
pfd.cRedShift = 0
pfd.cGreenBits = 0
pfd.cGreenShift = 0
pfd.cBlueBits = 0
pfd.cBlueShift = 0
pfd.cAlphaBits = 0
pfd.cAlphaShift = 0
pfd.cAccumBits = 0
pfd.cAccumRedBits = 0
pfd.cAccumGreenBits = 0
pfd.cAccumBlueBits = 0
pfd.cAccumAlphaBits = 0
pfd.cDepthBits = %GL_DEPTHBITS
pfd.cStencilBits = 0
pfd.cAuxBuffers = 0
pfd.iLayerType = %PFD_MAIN_PLANE
pfd.bReserved = 0
pfd.dwLayerMask = 0
pfd.dwVisibleMask = 0
pfd.dwDamageMask = 0
' Find a matching pixel format
pf = ChoosePixelFormat(hDC, pfd)
IF ISFALSE pf THEN
MessageBox hwnd, "Can't find a suitable pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Set the pixel format
IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN
MessageBox hwnd, "Can't set the pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Create a new OpenGL rendering context
hRC = wglCreateContext(hDC)
IF ISFALSE hRC THEN
MessageBox hwnd, "Can't create an OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' Make it current
IF ISFALSE wglMakeCurrent(hDC,hRC) THEN
MessageBox hwnd, "Can't activate the OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
EXIT FUNCTION
CASE %WM_DESTROY
' Clear resources
Cleanup hwnd
' Release the device and rendering contexts
wglMakeCurrent hDC, 0
' Make the rendering context no longer current
wglDeleteContext hRC
' Release the device context
ReleaseDC hwnd, hDC
' Post an WM_QUIT message
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_SIZE
ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
EXIT FUNCTION
END SELECT
' Call the default window procedure to process unhandled messages
FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
END FUNCTION
' ==========================================================================
I will check if earthmap.jpg file does function as well as I wished. thanks patrice for little help. best regards, frank
Search for the Boing2 project in my section.
...