'/*
' *  This Code Was Created By Jeff Molofee 2000
' *  A HUGE Thanks To Fredric Echols For Cleaning Up
' *  And Optimizing This Code, Making It More Flexible!
' *  If You've Found This Code Useful, Please Let Me Know.
' *  Visit My Site At nehe.gamedev.net
' */

#Include "windows.bi"  '' Header File For Windows
#Include "crt/string.bi"
#Include Once "GL/gl.bi"
#Include Once "GL/glu.bi"

Dim Shared As HDC hDC  ' Private GDI Device Context
Dim Shared As HGLRC  hRC  ' Permanent Rendering Context
Dim Shared As HWND  hWnd  ' Holds Our Window Handle
Dim Shared As HINSTANCE    hInstance    ' Holds The Instance Of The Application

Dim Shared As bool    keys(256)   ' Array Used For The Keyboard Routine
Dim Shared As bool    active = TRUE  ' Window Active Flag Set To TRUE By Default
Dim Shared As bool    fullscreen = TRUE    ' Fullscreen Flag Set To Fullscreen Mode By Default
Dim Shared As ZString*32 classOGL = "OpenGL"
Declare Function WndProc(As HWND, As UINT,As WPARAM, As LPARAM) As Integer    ' Declaration For WndProc
Declare Function WinMain(    hInstance As HINSTANCE    , _   ' Instance
hPrevInstance As HINSTANCE    , _  ' Previous Instance
lpCmdLine As LPSTR , _   ' Command Line Parameters
nCmdShow As Integer)As Integer   ' Window Show State

WinMain( GetModuleHandle(NULL) ,NULL,GetCommandLine(), SW_SHOWNORMAL )

Sub ReSizeGLScene(width_ As GLsizei ,height As  GLsizei )  ' Resize And Initialize The GL Window

  If (height=0)    Then    height=1        ' Prevent A Divide By Zero By  Making Height Equal One

  glViewport(0,0,width_,height)      ' Reset The Current Viewport

  glMatrixMode(GL_PROJECTION)      ' Select The Projection Matrix
  glLoadIdentity()       ' Reset The Projection Matrix

  ' Calculate The Aspect Ratio Of The Window
  gluPerspective(45.0f,Cast(GLfloat,Width_)/Cast(GLfloat,height),0.1f,100.0f)

  glMatrixMode(GL_MODELVIEW)       ' Select The Modelview Matrix
  glLoadIdentity()         ' Reset The Modelview Matrix
End Sub

Function InitGL() As Integer                              ' All Setup For OpenGL Goes Here
  glShadeModel(GL_SMOOTH)       ' Enable Smooth Shading
  glClearColor(0.0f, 0.0f, 0.0f, 0.5f)    ' Black Background
  glClearDepth(1.0f)         ' Depth Buffer Setup
  glEnable(GL_DEPTH_TEST)       ' Enables Depth Testing
  glDepthFunc(GL_LEQUAL)       ' The Type Of Depth Testing To Do
  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)    ' Really Nice Perspective Calculations
  Return TRUE                              ' Initialization Went OK
End Function

Function DrawGLScene()As Integer         ' Here's Where We Do All The Drawing
  glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT)    ' Clear Screen And Depth Buffer
  glLoadIdentity()        ' Reset The Current Modelview Matrix
  glTranslatef(-1.5f,0.0f,-6.0f)      ' Move Left 1.5 Units And Into The Screen 6.0
  glBegin(GL_TRIANGLES)        ' Drawing Using Triangles
  glVertex3f( 0.0f, 1.0f, 0.0f)     ' Top
  glVertex3f(-1.0f,-1.0f, 0.0f)     ' Bottom Left
  glVertex3f( 1.0f,-1.0f, 0.0f)     ' Bottom Right
  glEnd()                              ' Finished Drawing The Triangle
  glTranslatef(3.0f,0.0f,0.0f)      ' Move Right 3 Units
  glBegin(GL_QUADS)         ' Draw A Quad
  glVertex3f(-1.0f, 1.0f, 0.0f)     ' Top Left
  glVertex3f( 1.0f, 1.0f, 0.0f)     ' Top Right
  glVertex3f( 1.0f,-1.0f, 0.0f)     ' Bottom Right
  glVertex3f(-1.0f,-1.0f, 0.0f)     ' Bottom Left
  glEnd()                              ' Done Drawing The Quad
  Return TRUE                              ' Everything Went OK
End Function

Sub KillGLWindow()        ' Properly Kill The Window
  If (fullscreen) Then                              ' Are We In Fullscreen Mode?
   ChangeDisplaySettings(NULL,0)     ' If So Switch Back To The Desktop
   ShowCursor(TRUE)        ' Show Mouse Pointer
  EndIf

  If (hRC)    Then                              ' Do We Have A Rendering Context?
   If (wglMakeCurrent(NULL,NULL) = FALSE)Then     ' Are We Able To Release The DC And RC Contexts?
    MessageBox(NULL,"Release Of DC And RC Failed.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
   EndIf

   If (wglDeleteContext(hRC) = FALSE) Then     ' Are We Able To Delete The RC?
    MessageBox(NULL,"Release Rendering Context Failed.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
   EndIf
   hRC=NULL                              ' Set RC To NULL
  EndIf

  If (hDC=TRUE And (ReleaseDC(hWnd,hDC) = FALSE))    Then    ' Are We Able To Release The DC
   MessageBox(NULL,"Release Device Context Failed.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
   hDC=NULL                              ' Set DC To NULL
  EndIf

  If (hWnd=TRUE And (DestroyWindow(hWnd) = FALSE))    Then    ' Are We Able To Destroy The Window?
   MessageBox(NULL,"Could Not Release hWnd.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
   hWnd=NULL                              ' Set hWnd To NULL
  EndIf

  If (UnregisterClass("OpenGL",hInstance) = FALSE)    Then  ' Are We Able To Unregister Class
   MessageBox(NULL,"Could Not Unregister Class.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
   hInstance=NULL         ' Set hInstance To NULL
  EndIf
End Sub

'/*    This Code Creates Our OpenGL Window.  Parameters Are:     *
' *    title   - Title To Appear At The Top Of The Window    *
' *    width   - Width Of The GL Window Or Fullscreen Mode    *
' *    height   - Height Of The GL Window Or Fullscreen Mode   *
' *    bits   - Number Of Bits To Use For Color (8/16/24/32)   *
' *    fullscreenflag    - Use Fullscreen Mode (TRUE) Or Windowed Mode (FALSE)    */

Function CreateGLWindow(title As ZString Ptr , Width_ As Integer ,height As Integer ,bits As Integer ,fullscreenflag As bool ) As BOOL
  Dim As GLuint PixelFormat   ' Holds The Results After Searching For A Match
  Dim As WNDCLASS    wc      ' Windows Class Structure
  Dim As DWORD  dwExStyle    ' Window Extended Style
  Dim As DWORD  dwStyle    ' Window Style
  Dim As RECT  WindowRect    ' Grabs Rectangle Upper Left / Lower Right Values
  WindowRect.left = 0   ' Set Left Value To 0
  WindowRect.right = Width_  ' Set Right Value To Requested Width
  WindowRect.top = 0   ' Set Top Value To 0
  WindowRect.bottom = height  ' Set Bottom Value To Requested Height

  fullscreen=fullscreenflag   ' Set The Global Fullscreen Flag

  hInstance   = GetModuleHandle(NULL)    ' Grab An Instance For Our Window
  wc.style   = CS_HREDRAW Or CS_VREDRAW Or CS_OWNDC    ' Redraw On Size, And Own DC For Window.
  wc.lpfnWndProc  = Cast(WndProc, @WndProc)     ' WndProc Handles Messages
  wc.hInstance  = hInstance       ' Set The Instance
  wc.hIcon   = LoadIcon(NULL, IDI_WINLOGO)   ' Load The Default Icon
  wc.hCursor   = LoadCursor(NULL, IDC_ARROW)   ' Load The Arrow Pointer
  wc.hbrBackground    = NULL         ' No Background Required For GL
  wc.lpszMenuName  = NULL         ' We Don't Want A Menu
  wc.lpszClassName    = StrPtr(classOGL)       ' Set The Class Name

  If (RegisterClass(@wc)=FALSE) Then    ' Attempt To Register The Window Class
   MessageBox(NULL,"Failed To Register The Window Class.","ERROR",MB_OK+MB_ICONEXCLAMATION)
   Return FALSE                              ' Return FALSE
  EndIf

  If (fullscreen) Then                              ' Attempt Fullscreen Mode?
   Dim As DEVMODE dmScreenSettings        ' Device Mode
   memset(@dmScreenSettings,0,SizeOf(dmScreenSettings))    ' Makes Sure Memory's Cleared
   dmScreenSettings.dmSize=SizeOf(dmScreenSettings)  ' Size Of The Devmode Structure
   dmScreenSettings.dmPelsWidth    = width_    ' Selected Screen Width
   dmScreenSettings.dmPelsHeight    = height    ' Selected Screen Height
   dmScreenSettings.dmBitsPerPel    = bits     ' Selected Bits Per Pixel
   dmScreenSettings.dmFields=DM_BITSPERPEL+DM_PELSWIDTH+DM_PELSHEIGHT

   ' Try To Set Selected Mode And Get Results.  NOTE: CDS_FULLSCREEN Gets Rid Of Start Bar.
   If (ChangeDisplaySettings(@dmScreenSettings,CDS_FULLSCREEN)<>DISP_CHANGE_SUCCESSFUL) Then
    ' If The Mode Fails, Offer Two Options.  Quit Or Use Windowed Mode.
    If (MessageBox(NULL,!"The Requested Fullscreen Mode Is Not Supported By\nYour Video Card. Use Windowed Mode Instead?","NeHe GL",MB_YESNO+MB_ICONEXCLAMATION)=IDYES) Then
     fullscreen=FALSE  ' Windowed Mode Selected.  Fullscreen = FALSE
    Else
     ' Pop Up A Message Box Letting User Know The Program Is Closing.
     MessageBox(NULL,"Program Will Now Close.","ERROR",MB_OK+MB_ICONSTOP)
     Return FALSE         ' Return FALSE
    EndIf
   EndIf
  EndIf

  If (fullscreen) Then                              ' Are We Still In Fullscreen Mode?
   dwExStyle=WS_EX_APPWINDOW        ' Window Extended Style
   dwStyle=WS_POPUP                              ' Windows Style
   ShowCursor(FALSE)                              ' Hide Mouse Pointer
  Else
   dwExStyle=WS_EX_APPWINDOW + WS_EX_WINDOWEDGE   ' Window Extended Style
   dwStyle=WS_OVERLAPPEDWINDOW       ' Windows Style
  EndIf

  AdjustWindowRectEx(@WindowRect, dwStyle, FALSE, dwExStyle)  ' Adjust Window To True Requested Size

  ' Create The Window
  hWnd=CreateWindowEx(    dwExStyle, _       ' Extended Style For The Window
  "OpenGL", _       ' Class Name
  title, _        ' Window Title
  dwStyle + _       ' Defined Window Style
  WS_CLIPSIBLINGS + _     ' Required Window Style
  WS_CLIPCHILDREN, _     ' Required Window Style
  0, 0,    _       ' Window Position
  WindowRect.right-WindowRect.left, _    ' Calculate Window Width
  WindowRect.bottom-WindowRect.top, _    ' Calculate Window Height
  NULL,    _       ' No Parent Window
  NULL,    _       ' No Menu
  hInstance, _       ' Instance
  NULL)
  If hwnd = FALSE Then       ' Dont Pass Anything To WM_CREATE
   KillGLWindow()        ' Reset The Display
   MessageBox(NULL,"Window Creation Error.","ERROR",MB_OK+MB_ICONEXCLAMATION)
   Return FALSE        ' Return FALSE
  EndIf

  Static As PIXELFORMATDESCRIPTOR pfd   ' pfd Tells Windows How We Want Things To Be
  With pfd
   .nSize        = SizeOf(PIXELFORMATDESCRIPTOR)' Size Of This Pixel Format Descriptor
   .nVersion     = 1  ' Version Number
   .dwFlags      = PFD_DRAW_TO_WINDOW _  ' Format Must Support Window
   Or PFD_SUPPORT_OPENGL _ ' Format Must Support OpenGL
   Or PFD_DOUBLEBUFFER  ' Must Support Double Buffering
   .iPixelType   = PFD_TYPE_RGBA  ' Request An RGBA Format
   .iLayerType   = PFD_MAIN_PLANE ' Main Drawing Layer
   .cColorBits   = bits ' Select Our Color Depth
   .cDepthBits   = 16 ' 16Bit Z-Buffer (Depth Buffer)
  End With

  hDC=GetDC(hWnd)
  If (hDC=FALSE)    Then      ' Did We Get A Device Context?
   KillGLWindow()        ' Reset The Display
   MessageBox(NULL,"Can't Create A GL Device Context.","ERROR",MB_OK+MB_ICONEXCLAMATION)
   Return FALSE        ' Return FALSE
  EndIf

  PixelFormat=ChoosePixelFormat(hDC,@pfd)
  If (PixelFormat=FALSE)    Then' Did Windows Find A Matching Pixel Format?
   KillGLWindow()        ' Reset The Display
   MessageBox(NULL,"Can't Find A Suitable PixelFormat.","ERROR",MB_OK+MB_ICONEXCLAMATION)
   Return FALSE        ' Return FALSE
  EndIf

  If(SetPixelFormat(hDC,PixelFormat,@pfd) = FALSE)    Then    ' Are We Able To Set The Pixel Format?
   KillGLWindow()        ' Reset The Display
   MessageBox(NULL,"Can't Set The PixelFormat.","ERROR",MB_OK+MB_ICONEXCLAMATION)
   Return FALSE        ' Return FALSE
  EndIf

  hRC=wglCreateContext(hDC)
  If (hRC = FALSE) Then    ' Are We Able To Get A Rendering Context?
   KillGLWindow()        ' Reset The Display
   MessageBox(NULL,"Can't Create A GL Rendering Context.","ERROR",MB_OK+MB_ICONEXCLAMATION)
   Return FALSE        ' Return FALSE
  EndIf

  If(wglMakeCurrent(hDC,hRC) = FALSE) Then     ' Try To Activate The Rendering Context
   KillGLWindow()        ' Reset The Display
   MessageBox(NULL,"Can't Activate The GL Rendering Context.","ERROR",MB_OK+MB_ICONEXCLAMATION)
   Return FALSE        ' Return FALSE
  EndIf

  ShowWindow(hWnd,SW_SHOW)      ' Show The Window
  SetForegroundWindow(hWnd)      ' Slightly Higher Priority
  SetFocus(hWnd)         ' Sets Keyboard Focus To The Window
  ReSizeGLScene(width_, height)     ' Set Up Our Perspective GL Screen

  If (InitGL() = FALSE)    Then        ' Initialize Our Newly Created GL Window
   KillGLWindow()        ' Reset The Display
   MessageBox(NULL,"Initialization Failed.","ERROR",MB_OK+MB_ICONEXCLAMATION)
   Return FALSE        ' Return FALSE
  EndIf

  Return TRUE         ' Success
End Function

Function WndProc(hWnd As HWND    ,    _  ' Handle For This Window
  uMsg As UINT, _   ' Message For This Window
  wParam As WPARAM, _   ' Additional Message Information
  lParam As LPARAM) As Integer   ' Additional Message Information

  Select Case uMsg        ' Check For Windows Messages
   Case WM_ACTIVATE       ' Watch For Window Activate Message
    If (HiWord(wParam) = FALSE)    Then    ' Check Minimization State
     active=TRUE      ' Program Is Active
    Else
     active=FALSE      ' Program Is No Longer Active
    EndIf
    Return 0        ' Return To The Message Loop
   Case WM_SYSCOMMAND       ' Intercept System Commands
    Select Case wParam       ' Check System Calls
     Case SC_SCREENSAVE     ' Screensaver Trying To Start?
     Case SC_MONITORPOWER    ' Monitor Trying To Enter Powersave?
      Return 0       ' Prevent From Happening
    End Select
   Case WM_CLOSE        ' Did We Receive A Close Message?
    PostQuitMessage(0)      ' Send A Quit Message
    Return 0        ' Jump Back
   Case WM_KEYDOWN       ' Is A Key Being Held Down?
    keys(wParam) = TRUE     ' If So, Mark It As TRUE
    Return 0        ' Jump Back
   Case WM_KEYUP        ' Has A Key Been Released?
    keys(wParam) = FALSE     ' If So, Mark It As FALSE
    Return 0       ' Jump Back
   Case WM_SIZE        ' Resize The OpenGL Window
    ReSizeGLScene(LoWord(lParam),HiWord(lParam))  ' LoWord=Width, HiWord=Height
    Return 0        ' Jump Back
  End Select
  ' Pass All Unhandled Messages To DefWindowProc
  Return DefWindowProc(hWnd,uMsg,wParam,lParam)
End Function

Function WinMain(    hInstance As HINSTANCE    , _   ' Instance
  hPrevInstance As HINSTANCE    , _  ' Previous Instance
  lpCmdLine As LPSTR , _   ' Command Line Parameters
  nCmdShow As Integer)As Integer   ' Window Show State

  Dim As MSG  msg         ' Windows Message Structure
  Dim As BOOL    done = FALSE       ' Bool Variable To Exit Loop

  ' Ask The User Which Screen Mode They Prefer
  If (MessageBox(NULL,"Would You Like To Run In Fullscreen Mode?", "Start FullScreen?",MB_YESNO+MB_ICONQUESTION)=IDNO) Then
   fullscreen = FALSE       ' Windowed Mode
  EndIf

  ' Create Our OpenGL Window
  If (CreateGLWindow("NeHe's OpenGL Framework",640,480,16,fullscreen) = FALSE) Then
   Return 0         ' Quit If Window Was Not Created
  EndIf

  While(done = FALSE)         ' Loop That Runs While done=FALSE
   If (PeekMessage(@msg,NULL,0,0,PM_REMOVE))Then    ' Is There A Message Waiting?
    If (msg.message=WM_QUIT)    Then   ' Have We Received A Quit Message?
     done=TRUE       ' If So done=TRUE
    Else         ' If Not, Deal With Window Messages
     TranslateMessage(@msg)    ' Translate The Message
     DispatchMessage(@msg)    ' Dispatch The Message
    EndIf
   Else                              ' If There Are No Messages
    ' Draw The Scene.  Watch For ESC Key And Quit Messages From DrawGLScene()
    If (active) Then        ' Program Active?
     If (keys(VK_ESCAPE))    Then   ' Was ESC Pressed?
      done=TRUE      ' ESC Signalled A Quit
     Else        ' Not Time To Quit, Update Screen
      DrawGLScene()     ' Draw The Scene
      SwapBuffers(hDC)    ' Swap Buffers (Double Buffering)
     EndIf
    EndIf

    If (keys(VK_F1))    Then     ' Is F1 Being Pressed?
     keys(VK_F1) = FALSE     ' If So Make Key FALSE
     KillGLWindow()      ' Kill Our Current Window
     fullscreen= (fullscreen Xor 1)    ' Toggle Fullscreen / Windowed Mode
     ' Recreate Our OpenGL Window
     If (CreateGLWindow("NeHe's OpenGL Framework",640,480,16,fullscreen) = FALSE) Then
      Return 0      ' Quit If Window Was Not Created
     EndIf
    EndIf
   EndIf
  Wend

  ' Shutdown
  KillGLWindow()         ' Kill The Window
  Return (msg.wParam)      ' Exit The Program
End Function