• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

Sphere_Mapping Correct? (OpenGL question)

Started by Frank Brübach, September 13, 2011, 07:49:00 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Frank Brübach

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

Frank Brübach

#1
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

Patrice Terrier

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.

...
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Frank Brübach

#3
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

Patrice Terrier

No need to use GL_TEXTURE_RECTANGLE_ARB

Just use a rectangular texture, like the one attached to this post.

...
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Frank Brübach

#5
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

Patrice Terrier

Search for the Boing2 project in my section.

...
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com