unit GMWindow;

interface
    uses Windows,Messages,OpenGl,GMMap,GMVars,GMUtilite;

procedure CreateTheWindow(Width, Height,_SCRHZ,_SCRBit: Integer;_FullScreen:boolean;Vsync : boolean=false);
procedure DestroyTheWindow;
function WindowProcedure(Window: hWnd; Message, wParam: Word; lParam: LongInt): LongInt;stdcall;
procedure SetPerspective(Width, Height: Integer);
function WinMain(hInstance: HINST; hPrevInstance: HINST; lpCmdLine: PChar; nCmdShow: Integer): Integer;
procedure ChangeToFullscreen;
procedure InitializeMyGL;

procedure WndSetCaption(text:string);

implementation

procedure WndSetCaption(text:string);
begin
  GWCaption := text + #0;
 if GWHandle <> 0 Then
    SetWindowText( GWHandle, PChar( GWCaption ));
end;

procedure SetPixFormat(HDC: HDC);
var pfd: TPixelFormatDescriptor;
    nPixelFormat: Integer;
begin
 with pfd do
  begin
   nSize := SizeOf(TPixelFormatDescriptor); // размер структуры
   nVersion := 1;                            // номер версии
   dwFlags := PFD_DOUBLEBUFFER or PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL; // множество битовых флагов, определяющих устройство и интерфейс
   iPixelType := PFD_TYPE_RGBA; // режим для изображения цветов
   cColorBits := SCRBit;            // число битовых плоскостей в каждом буфере цвета
   cRedBits := 0;               // число битовых плоскостей красного в каждом буфере RGBA
   cRedShift := 0;              // смещение от начала числа битовых плоскостей красного в каждом буфере RGBA
   cGreenBits := 0;             // число битовых плоскостей зелёного в каждом буфере RGBA
   cGreenShift := 0;            // смещение от начала числа битовых плоскостей зелёного в каждом буфере RGBA
   cBlueBits := 0;              // число битовых плоскостей синего в каждом буфере RGBA
   cBlueShift := 0;             // смещение от начала числа битовых плоскостей синего в каждом буфере RGBA
   cAlphaBits := 0;             // число битовых плоскостей альфа в каждом буфере RGBA
   cAlphaShift := 0;            // смещение от начала числа битовых плоскостей альфа в каждом буфере RGBA
   cAccumBits := 0;             // общее число битовых плоскостей в буфере аккумулятора
   cAccumRedBits := 0;          // число битовых плоскостей красного в буфере аккумулятора
   cAccumGreenBits := 0;        // число битовых плоскостей зелёного в буфере аккумулятора
   cAccumBlueBits := 0;         // число битовых плоскостей синего в буфере аккумулятора
   cAccumAlphaBits := 0;        // число битовых плоскостей альфа в буфере аккумулятора
   cDepthBits := 32;            // размер буфера глубины (ось z) =16
   cStencilBits := 0;           // размер буфера трафарета
   cAuxBuffers := 0;            // число вспомогательных буферов
   iLayerType := PFD_MAIN_PLANE;// тип плоскости
   bReserved := 0;              // число плоскостей переднего и заднего плана
   dwLayerMask := 0;            // игнорируется
   dwVisibleMask := 0;          // индекс или цвет прозрачности нижней плоскости
   dwDamageMask := 0;           // игнорируется
  end;

 nPixelFormat := ChoosePixelFormat(HDC, @pfd); // запрос системе - поддерживается ли выбранный формат пикселей
  if (nPixelFormat = 0) then
  begin
    MessageBox(0, 'Unable to find a suitable pixel format!', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;
   // устанавливаем формат пикселей в контексте устройства
  if (not  SetPixelFormat(HDC, nPixelFormat, @pfd)) then
  begin
    MessageBox(0, 'Unable to set the pixel format!', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

end;

// Initialize OpenGL
procedure InitializeMyGL;
var
A,B:Integer;
rcWindowClient:Trect;

begin
// GL
 GWDC := GetDC(GWHandle);
  if (GWDC = 0) then
  begin
    MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

 SetPixFormat(GWDC);


 GWHRC := wglCreateContext(GWDC);
 if (GWHRC = 0) then
  begin
    MessageBox(0, 'Unable to create an OpenGL rendering context!', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

 ReleaseDC(GWHandle, GWDC);

 if (not wglMakeCurrent(GWDC, GWHRC)) then
  begin
    MessageBox(0, 'Unable to activate OpenGL rendering context!', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  ReadExtensions;
  ReadImplementationProperties;

 if Sync then VBL2(vsmSync) else VBL2(vsmNoSync);

   GetClientRect(GWHandle, rcWindowClient);
   SCRXOffset := (SCRW - (rcWindowClient.right - rcWindowClient.left));
   SCRYOffset := (SCRH - (rcWindowClient.bottom - rcWindowClient.top));

 a:=0;
 b:=0;
 if FullScreen=false then
 begin
   SystemParametersInfo(SPI_GETWORKAREA, 0, @rcWindowClient, 0);
   if CenterScreen then
   begin
     a:= (rcWindowClient.Right div 2)-((SCRW + SCRXOffset) div 2);
     b:= (rcWindowClient.Bottom div 2)-((SCRH + SCRYOffset) div 2);
   end;
 end;

   SetWindowPos(GWHandle, 0, a, b,
          SCRW + SCRXOffset,  // Ширина
          SCRH + SCRYOffset, // Высота
          0);


 ShowWindow(GWHandle, SW_SHOW);
 SetForegroundWindow(GWHandle);
 SetFocus(GWHandle);
 EngineStart:=true;
 SetPerspective(SCRW, SCRH);

        glClearDepth (1.0);										// Depth Buffer Setup
	glDepthFunc (GL_LEQUAL);									// The Type Of Depth Testing (Less Or Equal)
	glEnable (GL_DEPTH_TEST);									// Enable Depth Testing
	glShadeModel (GL_SMOOTH);
        glDisable(GL_ALPHA_TEST);									// Select Smooth Shading
	glHint (GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);			// Set Perspective Calculations To Most Accurate
      // Back color
      glClearColor(255, 255, 255, 255);
     //  glClearColor(0, 0, 0, 255);
       randomize;
end;

// Finalize OpenGL
procedure FinalizeGL;
var
  i:Integer;
begin

 GameClose;

 for i:=0 to High(MySysfont) do FreeSystemFont2D(MySysfont[i]);


  if (not wglMakeCurrent(GWDC, 0)) then
  begin
    MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);
  end;

   if (not wglDeleteContext(GWHRC)) then
  begin
    MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
    GWHRC:= 0;
  end;

  if ((GWDC > 0) and (ReleaseDC(GWHandle, GWDC) = 0)) then
  begin
    MessageBox(0, 'Release of device context failed!', 'Error', MB_OK or MB_ICONERROR);
    GWDC := 0;
  end;


   if ((GWHandle <> 0) and (not DestroyWindow(GWHandle))) then
  begin
    MessageBox(0, 'Unable to destroy window!', 'Error', MB_OK or MB_ICONERROR);
    GWHandle := 0;
  end;

  if (not UnRegisterClass(Title, GWInstance)) then
  begin
    MessageBox(0, 'Unable to unregister window class!', 'Error', MB_OK or MB_ICONERROR);
    GWInstance := 0;
  end;


end;



// Change to fullscreen mode
procedure ChangeToFullscreen;
var DeviceMode: DEVMODE;
begin
 ZeroMemory(@DeviceMode, SizeOf(DeviceMode));
 with DeviceMode do
  begin
   dmSize := SizeOf(DeviceMode);
   dmPelsWidth := SCRW;
   dmPelsHeight := SCRH;
   dmBitsPerPel := SCRBit;
   dmDisplayFrequency:=SCRHZ;
   dmFields     := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY;
  end;

  if (ChangeDisplaySettings(DeviceMode, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
    begin
      MessageBox(0, 'Unable to switch to fullscreen!', 'Error', MB_OK or MB_ICONERROR);
      Fullscreen := False;
    end;
end;

// Setup DC pixel format



// Setup a perspective
procedure SetPerspective(Width, Height: Integer);
begin
if EngineStart then
begin
 glViewport(0, 0, Width, Height);
 glMatrixMode(GL_PROJECTION);
 glLoadIdentity;
 gluPerspective(45.0, Width / Height, 0.1, 300);
 glMatrixMode(GL_MODELVIEW);
 glLoadIdentity;
 end;
end;


// Window procedure: processing messges
function WindowProcedure(Window: hWnd; Message, wParam: Word; lParam: LongInt): LongInt;stdcall;
begin
 case Message of
  // Window create
  WM_CREATE:
   begin
   end;
  // Window resize
  WM_SIZE:
   begin
    SetPerspective(LOWORD(lParam),HIWORD(lParam));
   end;
  // Window close
  WM_CLOSE:
   begin
    PostQuitMessage(0);
    Exit;
   end;
  // Key down
  WM_KEYDOWN:
   begin
    Keys[wParam] := True;
   end;
  // Key up
  WM_KEYUP:
   begin
      Keys[wParam] := False;
   end;
   // обработка мыши
  WM_MOUSEMOVE:  begin//GetCursorPos(MousePos);
                  MousePos.X    := WORD( lParam );
                  MousePos.Y    := lParam shr 16;
                 end;
  WM_LBUTTONUP   : Keys[MouseLB] := False;
  WM_RBUTTONUP   : Keys[MouseRB] := False;
  WM_MBUTTONUP   : Keys[MouseMB] := False;
  WM_LBUTTONDOWN : Keys[MouseLB] := True;
  WM_RBUTTONDOWN : Keys[MouseRB] := True;
  WM_MBUTTONDOWN : Keys[MouseMB] := True;
 else Result := DefWindowProc(Window, Message, wParam, lParam);
 end;
end;


// Create the window
procedure CreateTheWindow(Width, Height,_SCRHZ,_SCRBit: Integer;_FullScreen:boolean;Vsync : boolean=false);
var WindowClass: TWndClass;
    Style: DWORD;
    dwExStyle : DWORD;
begin
  SCRW:=Width;
  SCRH:=Height;
  SCR2W:=SCRW div 2;
  SCR2H:=SCRH div 2;;
  SCRHZ:=_SCRHZ; //Частота обновления
  SCRBit:=_SCRBit; //Разрядность цвета
  FullScreen:=_FullScreen;
  Sync:=Vsync;//вертикальная синхронизация

  EngineStart:=false;

    InitOpenGL;

 GWInstance := GetModuleHandle(nil);

 ZeroMemory(@WindowClass, SizeOf(WindowClass));
 with WindowClass do
  begin
   Style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
   lpfnWndProc := @WindowProcedure;
   cbClsExtra := 0;
   cbWndExtra := 0;
   hInstance := GWInstance;
   hIcon := LoadIcon(0, IDI_APPLICATION);
   hCursor := LoadCursor(0, IDC_ARROW);
   hbrBackground := GetStockObject(WHITE_BRUSH);
   lpszMenuName := '';
   lpszClassName := Title;
  end;

  if (RegisterClass(WindowClass) = 0) then
  begin
    MessageBox(0, 'Failed to register the window class...', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

 if FullScreen then
  begin
   ChangeToFullscreen;
   Style := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
  end
 else
 begin
  Style := WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU or WS_VISIBLE;

  //WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
 end;

 // ShowCursor(FALSE);

  GWHandle := CreateWindowEx(WS_EX_APPWINDOW or WS_EX_WINDOWEDGE, TITLE, TITLE, Style, 0, 0, Width, Height, 0, 0, GWInstance, nil);

 if GWHandle = 0 then
  begin
    MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  ups_delta    := 25;
  ups_time_old := GetTimer - ups_delta;
  ups_time     := GetTimer;


 InitializeMyGL;

  Pathstr:=extractfiledir(paramstr(0))+'\';

 GameInit;

  CurrentTime := GetTickCount;
  FPSLastTickCount := CurrentTime;
  FPSFrames        := 0;
  FPS              := 0;

end;

// Destroy the window
procedure DestroyTheWindow;
begin
 if Fullscreen then
  begin
   ChangeDisplaySettings(TDevMode(nil^), CDS_FULLSCREEN);
   ShowCursor(True);
  end;
 FinalizeGL;
 DestroyWindow(GWHandle);
 UnRegisterClass(TITLE, hInstance);
end;


// Main message loop for the application
function WinMain(hInstance: HINST; hPrevInstance: HINST; lpCmdLine: PChar; nCmdShow: Integer): Integer;
var Msg : TMsg;
    Finished : Boolean;
begin
 Finished := False;

 while not Finished do
  begin
   if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
     if Msg.Message = WM_QUIT then Finished := True
     else
      begin
       TranslateMessage(msg);
       DispatchMessage(msg);
      end;
    end
   else
    begin

     CurrentTime := GetTickCount;

      wTime       := GetTimer;
      wTime_Delta := wTime - ups_time_old;
      while wTime_Delta >= ups_delta do
        begin
          GameProcces;
          dec(wTime_Delta, ups_delta);
        end;
        ups_time_old := wTime - wTime_Delta;
        GameRender;

      if CurrentTime - FPSLastTickCount >= 1000 then
      begin
        FPS:=FPSFrames * 1000 / (CurrentTime - FPSLastTickCount);
        FPSFrames:=0;                  //Сброс значения прошедших кадров
        FPSLastTickCount:=CurrentTime; //Установка времени последнего расчёта
      end;

      Inc(FPSFrames);

    end;
  end;

 Result := Msg.wParam;
end;

end.
