
'====================================================================
'' OpenGL demo, modeless dialog as main.
''
'' The OpenGL code is mostly from the FBGFX_OpenGL example port of
'' NeHe Lesson 4, with the initialization code mostly from a MASM32
'' example by Franck Charlet. I'm not sure that the OpenGL code is
'' all correct, or that I trapped the most likely errors.
'====================================================================

#include "dialogs.bas"
#include "GL/gl.bi"
#include "GL/glu.bi"

Dim Shared As HDC dlgHDC

'====================================================================

Function DialogProc( Byval hDlg As  HWND, _
                     Byval uMsg As UINT, _
                     Byval wParam As WPARAM, _
                     Byval lParam As LPARAM ) As Integer

  Select Case uMsg

    Case WM_INITDIALOG

      Dim As PIXELFORMATDESCRIPTOR pfd
      Dim As Integer pixelFormatIndex
      Dim As HGLRC hglrc
      Dim As RECT rc

      dlgHDC = GetDC( hDlg )

      pfd.nSize       = sizeof(PIXELFORMATDESCRIPTOR)
      pfd.nVersion    = 1
      pfd.dwFlags     = PFD_DRAW_TO_WINDOW Or _
                        PFD_SUPPORT_OPENGL Or _
                        PFD_DOUBLEBUFFER
      pfd.dwLayerMask = PFD_MAIN_PLANE
      pfd.iPixelType  = PFD_TYPE_RGBA
      pfd.cColorBits  = 8
      pfd.cDepthBits  = 16

      pixelFormatIndex = ChoosePixelFormat( dlgHDC, @pfd )

      If SetPixelFormat( dlgHDC, pixelFormatIndex, @pfd ) = 0 Then
        MessageBox( hDlg, "SetPixelFormat failed", 0, 0 )
        DestroyWindow( hDlg )
      End If

      hglrc = wglCreateContext( dlgHDC )
      If hglrc = 0 Then
        MessageBox( hDlg, "wglCreateContext failed", 0, 0 )
        DestroyWindow( hDlg )
      End If

      If wglMakeCurrent( dlgHDC, hglrc ) = 0 Then
        MessageBox( hDlg, "wglMakeCurrent failed", 0, 0 )
        DestroyWindow( hDlg )
      End If

      GetClientRect( hDlg, @rc )

      glViewport 0, 0, rc.right, rc.bottom

      glMatrixMode GL_PROJECTION
      glLoadIdentity
      gluPerspective 45.0, rc.right/rc.bottom, 0.1, 100.0
      glMatrixMode GL_MODELVIEW
      glLoadIdentity

      glShadeModel GL_SMOOTH
      glClearColor 0.0, 0.0, 0.0, 1.0
      glClearDepth 1.0
      glEnable GL_DEPTH_TEST
      glDepthFunc GL_LEQUAL
      glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST

    Case WM_COMMAND

      If loword(wParam) = IDCANCEL Then

        DestroyWindow( hDlg )

      End If

    Case WM_CLOSE

      DestroyWindow( hDlg )

    Case WM_DESTROY

      PostQuitMessage( null )

  End Select

  Return 0

End Function

'====================================================================

Dim As LPDLGTEMPLATE lpdt
Dim As HWND hDlg
Dim As MSG wMsg

Dim rtri As Single, rquad As Single

Dialog( 0, 0, 0, 320, 240, "OpenGL in Dialog Demo", lpdt, _
        WS_OVERLAPPED Or WS_SYSMENU Or WS_VISIBLE Or DS_CENTER )

hDlg = CreateModelessDialog( 0, @DialogProc, 0, lpdt )

'' This special message loop is useful when some action needs to
'' be repeated at a very high rate. Where the minimum effective
'' period for a normal timer is about 10ms, the effective period
'' for this message loop running on the typical system is well
'' under one microsecond. PM_REMOVE indicates that we want the
'' messages removed from the message queue as we process them.
''
Do
  If PeekMessage( @wMsg, null, 0, 0, PM_RemOVE ) <> 0 then

    '' PeekMessage returned non-zero, indicating that a
    '' message is available. If the message was WM_QUIT,
    '' then it's time to exit.
    ''
    If wMsg.message = WM_QUIT Then Exit Do

    If IsDialogMessage( hDlg,  @wMsg ) = 0 Then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
    End If

  Else

    glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
    glLoadIdentity
    glTranslatef -1.5, 0.0, -6.0
    glRotatef rtri, 0, 1, 0
    glBegin GL_TRIANGLES
      glColor3f 1.0, 0.0, 0.0
      glVertex3f 0.0, 1.0, 0.0
      glColor3f 0.0, 1.0, 0.0
      glVertex3f -1.0, -1.0, 0.0
      glColor3f 0.0, 0.0, 1.0
      glVertex3f 1.0, -1.0, 0.0
    glEnd

    glLoadIdentity
    glTranslatef 1.5, 0.0, -6.0
    glColor3f 0.5, 0.5, 1.0
    glRotatef rquad, 1, 0, 0
    glBegin GL_QUADS
      glVertex3f -1.0, 1.0, 0.0
      glVertex3f 1.0, 1.0, 0.0
      glVertex3f 1.0, -1.0, 0.0
      glVertex3f -1.0, -1.0, 0.0
    glEnd
    rtri  += 1
    rquad += 2

    SwapBuffers( dlgHDC )

  End If

Loop

'====================================================================
 