// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ //.
//  OpenGL for FPC - Tutorial 07                      //
//                                                    //
//  Example of "wrong" depth.                         //
//                                                    //
//  Works with FPC 1.0.10.                            //
//                                                    //
//  (c)2002-2003 Delax^Sundancer Inc.                 //
//   delax@sundancerinc.de                            //
//                                                    //
//   www.friends-of-fpc.org                           //
 // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ //'

{$APPTYPE GUI}
{$MODE DELPHI}

program ogl_fpc_source07;

uses
  windows,
  gl;

var

  msg : TMSG;		// Windows messages
  hWindow : HWnd;	// Windows Handle to the OGL Window
  dcWindow : hDc;	// Device Context for the OGL Window
  rcWindow : HGLRC;	// Render Context for the OGL Window
 
  width, height, bits : longint;
  fullscreen, active : boolean;

  rotation : real;

// Try, Throw, Catch mechanism. Simple proc to display given errors. //
procedure ThrowError(pcErrorMessage : pChar);
begin
  MessageBox(0, pcErrorMessage, 'Error', MB_OK);
  Halt(0);
end;


// Standard WinProc. Handles all the messages from the System. //
function GLWndProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall; export;
begin
  GLWndProc := 0;

  case AMessage of
    wm_create:
      begin
	active := true;		// if GL Window was created correctly, then set
	Exit;			// active-flag to "true".
      end;

    wm_paint:
      begin
         exit;			// nothing to paint to Windows as we do all drawing with OGL
      end;

    wm_keydown:
      begin
	if wParam = VK_ESCAPE then SendMessage(hWindow,wm_destroy,0,0);
	Exit;			// check for ESC key. If pressed, then send quit message
      end;

    wm_destroy:
      begin
         active := false;	// if quit message was sent, exit the main loop by setting
         PostQuitMessage(0);	// the active-flag to "false".
         Exit;
      end;

   wm_syscommand:		// system wants something..
      begin
	case (wParam) of 
	  SC_SCREENSAVE : begin		// ..don't start any screensavers.
	        GLWndProc := 0;
	       end;

	  SC_MONITORPOWER : begin	// ..and don't kill monitor power.
	        GLWndProc := 0;
	       end;
        end;
      end;
 end;

  GLWndProc := DefWindowProc(Window, AMessage, WParam, LParam);	// let Windows deal with the rest of the messages.
end;


// Register the Window Class. //
function WindowRegister: Boolean;
var
  WindowClass: WndClass;
begin
  WindowClass.Style := cs_hRedraw or cs_vRedraw;
  WindowClass.lpfnWndProc := WndProc(@GLWndProc);		// Handle to our Windows messaging interface func.
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;
  WindowClass.hInstance := system.MainInstance;			// Get the Windows Instance for our app. 
  WindowClass.hIcon := LoadIcon(0, idi_Application);
  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
  WindowClass.lpszMenuName := nil;
  WindowClass.lpszClassName := 'GLWindow';			// Name the specified Window Class

  WindowRegister := RegisterClass(WindowClass) <> 0;
end;


// Create the OGL Window. //
function WindowCreate(pcApplicationName : pChar): HWnd;
var
  hWindow: HWnd;		// Handle to Window
  dmScreenSettings : DEVMODE;	// Used for Full Screen Mode
begin

 if fullscreen = false then begin	// OGL Window running in windowed mode

  hWindow := CreateWindow('GLWindow',
			  pcApplicationName,
			  WS_CAPTION OR WS_POPUPWINDOW OR WS_VISIBLE OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN,
			  cw_UseDefault,
			  cw_UseDefault,
			  width,
			  height,
			  0, 0,
			  system.MainInstance,
			  nil);

 end else begin		// OGL Window running in fullscreen mode

  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 OR DM_PELSWIDTH OR DM_PELSHEIGHT;

 if ChangeDisplaySettings(@dmScreenSettings,CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL then begin
    ThrowError('Screen resolution is not supported by your gfx card!');
    WindowCreate := 0;
    Exit;
 end;

  hWindow := CreateWindowEx(WS_EX_APPWINDOW,
			    'GLWindow',
			    pcApplicationName,
			    WS_POPUP OR WS_VISIBLE OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN,
			    0, 0,
			    width,
			    height,
			    0, 0,
			    system.MainInstance,
			    nil );

  ShowCursor(false);
 end;

  if hWindow <> 0 then begin
    ShowWindow(hWindow, CmdShow);
    UpdateWindow(hWindow);
  end;

  WindowCreate := hWindow;
end;


// Init the Window and bind OGL to it. //
function WindowInit(hParent : HWnd): Boolean;
var
  FunctionError : integer;
  pfd : PIXELFORMATDESCRIPTOR;
  iFormat : integer;	// Pixel Format

begin

 FunctionError := 0;

  dcWindow := GetDC( hParent );	// Get Device Context

  FillChar(pfd, sizeof(pfd), 0);	// Define Pixel Format
  pfd.nSize         := sizeof(pfd);
  pfd.nVersion      := 1;
  pfd.dwFlags       := PFD_SUPPORT_OPENGL OR PFD_DRAW_TO_WINDOW OR PFD_DOUBLEBUFFER;
  pfd.iPixelType    := PFD_TYPE_RGBA;
  pfd.cColorBits    := bits;
  pfd.cDepthBits    := 16;
  pfd.iLayerType    := PFD_MAIN_PLANE;

  iFormat := ChoosePixelFormat( dcWindow, @pfd );	// Create Pixel Format

  if (iFormat = 0) then FunctionError := 1;

  SetPixelFormat( dcWindow, iFormat, @pfd );		// Set Pixel Format
  rcWindow := wglCreateContext( dcWindow );		// Create OpenGL Context

  if (rcWindow = 0) then FunctionError := 2;

  wglMakeCurrent( dcWindow, rcWindow );		// Bind OpenGL to our Window

 if FunctionError = 0 then WindowInit := true else WindowInit := false;

end;


// Main function to create the Window. //
function CreateOGLWindow(pcApplicationName : pChar; iApplicationWidth, iApplicationHeight, iApplicationBits : longint; bApplicationFullscreen : boolean):Boolean;
begin
 width := iApplicationWidth;
 height := iApplicationHeight;
 bits := iApplicationBits;
 fullscreen := bApplicationFullscreen;

  if not WindowRegister then begin
    ThrowError('Could not register the Application Window!');
    CreateOGLWindow := false;
    Exit;
  end;

  hWindow := WindowCreate(pcApplicationName);
  if longint(hWindow) = 0 then begin
    ThrowError('Could not create Application Window!');
    CreateOGLWindow := false;
    Exit;
  end;

 if not WindowInit(hWindow) then begin
    ThrowError('Could not initialise Application Window!');
    CreateOGLWindow := false;
    Exit;
  end;

 CreateOGLWindow := true;
end;


// Kill Application Window again. //
procedure KillOGLWindow();
begin
  wglMakeCurrent( dcWindow, 0 );	// Kill Device Context
  wglDeleteContext( rcWindow );		// Kill Render Context
  ReleaseDC( hWindow, dcWindow );	// Release Window
  DestroyWindow( hWindow );		// Kill Window itself
end;


// Simple OGL initialisation for testing. //
procedure OpenGL_Init();
begin

  glClearColor( 0.0, 0.0, 0.0, 1.0 );

  glViewport( 0, 0, width, height );
  glMatrixMode( GL_PROJECTION );
  glLoadIdentity();

  glOrtho( -2, 2, -2*height/width, 2*height/width, -2, 2);

  glMatrixMode( GL_MODELVIEW );
  glLoadIdentity();

end;


procedure OpenGL_Draw();
begin

  glClear( GL_COLOR_BUFFER_BIT );
  glLoadIdentity();

  glRotatef( rotation, 0.0, 1.0, 0.0 );                         

  glBegin( GL_TRIANGLES );

    glColor3f(1.0, 0.0, 0.0);  

    glVertex3f(0.0, 1.0, 0.0);
    glVertex3f(-1.0, -1.0, 0.0);
    glVertex3f(1.0, -1.0, 0.0);

    glColor3f(0.0, 1.0, 0.0);  

    glVertex3f(0.0, 1.0, 1.0);
    glVertex3f(-1.0, -1.0, 1.0);
    glVertex3f(1.0, -1.0, 1.0);

  glEnd();

end;


// Main Loop. //
begin

 if MessageBox(0,'Fullscreen Mode?', 'Question!',MB_YESNO OR MB_ICONQUESTION) = IDNO 
  then fullscreen := false else fullscreen := true;

 CreateOGLWindow('Source 07', 640, 480, 32, fullscreen);
 OpenGL_Init();			// init opengl stuff

 rotation := 0.0;

 REPEAT				// start main proc

if PeekMessage(@msg,0,0,0,0) = true then begin
  GetMessage(@msg,0,0,0);
  TranslateMessage(msg);
  DispatchMessage(msg);
end;

 OpenGL_Draw();
 SwapBuffers( dcWindow );	// put opengl stuff to screen

 rotation += 0.2;

UNTIL active = false;		// end main proc

  KillOGLWindow();		// kill window stuff
end.