unit GLWindow;

interface

uses
  Windows, OpenGL, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, MiscRoutines, GLScene, GLBitDraw, GLState,
  Setup;

// =======================================================================
// Платформанно - зависимый код
// =======================================================================
type
  TOpenGLWindow         = class(TForm)
    FPSTimer            : TTimer;
    GLEditMenu: TMainMenu;
    OGLMenu: TMenuItem;
    Item320X240         : TMenuItem;
    Item400X300         : TMenuItem;
    Item480X360         : TMenuItem;
    Item512X384         : TMenuItem;
    Item640X480         : TMenuItem;
    Item800X600         : TMenuItem;
    Item960X720         : TMenuItem;
    Item1024X768        : TMenuItem;
    Item1280X1024       : TMenuItem;
    Item1600X1200       : TMenuItem;
    WindowSizeMenu: TMenuItem;
    CaptureItem: TMenuItem;
    BitDrawItem: TMenuItem;
    SaveDialog: TSaveDialog;
    LogItem: TMenuItem;
    FormatItem: TMenuItem;
    ResetPosItem: TMenuItem;
    procedure	GLShow(Sender: TObject);
    procedure	GLResize(Sender: TObject);
    procedure	FormClose(Sender: TObject; var Action: TCloseAction);
    procedure	FPSTimerTimer(Sender: TObject);
    procedure	FormCreate(Sender: TObject);
    procedure	FormPaint(Sender: TObject);
    procedure	Item320X240Click(Sender: TObject);
    procedure	Item400X300Click(Sender: TObject);
    procedure	Item480X360Click(Sender: TObject);
    procedure	Item512X384Click(Sender: TObject);
    procedure	Item640X480Click(Sender: TObject);
    procedure	Item800X600Click(Sender: TObject);
    procedure	Item960X720Click(Sender: TObject);
    procedure	Item1024X768Click(Sender: TObject);
    procedure	Item1280X1024Click(Sender: TObject);
    procedure	Item1600X1200Click(Sender: TObject);
    procedure	FormHide(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CaptureItemClick(Sender: TObject);
    procedure BitDrawItemClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure OGLMenuClick(Sender: TObject);
    procedure LogItemClick(Sender: TObject);
    procedure FormatItemClick(Sender: TObject);
    procedure ResetPosItemClick(Sender: TObject);
  private
    // Время - для физически адекватного моделирования мира
    Time                : integer;
    PreviousTime        : integer;
    PrevMode            : TGameMode;
    PauseRedraw         : Boolean;
    // Частота обновления
    FrameCount          : integer;
    // Истина, если текущий режим - не с прямым кодированием цвета
    PaletteNeeded       : Boolean;
    Palette             : HPALETTE;
    OldPalette          : HPALETTE;
    // Предыдущий обработчик события Application.OnIdle
    OldIdleHandler      : TIdleEvent;
    OldDeactivateHandler: TNotifyEvent;
    OldActivateHandler  : TNotifyEvent;
    // Обработчики специфических событий
    procedure           GLQueryNewPalette(var Msg: TMessage); message
      WM_QUERYNEWPALETTE;
    procedure           GLPaletteChanged(var Msg: TMessage); message
      WM_PALETTECHANGED;
    procedure           GLEraseBkgnd(var Msg: TWMEraseBkgnd); message
      WM_ERASEBKGND;
    procedure           GLEnterMenuLoop(var Msg: TMessage); message
      WM_ENTERMENULOOP;
    procedure           GLEnterSizeMove(var Msg: TMessage); message
      WM_ENTERSIZEMOVE;
    procedure           GLExitMenuLoop(var Msg: TMessage); message
      WM_EXITMENULOOP;
    procedure           GLExitSizeMove(var Msg: TMessage); message
      WM_EXITSIZEMOVE;
    procedure           GLDisplayChange(var Msg: TMessage); message
      WM_DISPLAYCHANGE;
    procedure           GLAdjustDisplayMenu;
    procedure           GLDeactivate(Sender: TObject);
    procedure           GLActivate(Sender: TObject);
    procedure           ApplicationIdle(Sender:TObject;var Done:Boolean);
    procedure           InitialDraw;
    procedure           GLDestroy;
    procedure           GLCreate;
  public
    Scene               : TOpenGLScene;
    // Уведомление для сервера
    NotifyGLClose       : TNotifyEvent;
    procedure           CaptureBuffer(var Dest:TBitmap);
    procedure           DrawToBitmap(var Dest:TBitmap);
    procedure           Pause;
    procedure           Resume;
    procedure           SetupChanged;
  end;

// =======================================================================
implementation

uses GraphS;

{$R *.DFM}

// =======================================================================
// Служебные процедуры - создание контекста OpenGL
// =======================================================================

const
  threeto8  : array[0..7] of Byte = (0,36,73,109,146,182,219,255);
  twoto8    : array[0..3] of Byte = (0,$55,$aa,$ff);
  oneto8    : array[0..1] of Byte = (0,255);
  defaultOverride : array[0..12] of Dword = (0,3,24,27,64,67,88,173,181,
    236,247,164,91);
  defaultPalEntry : array[0..79] of Byte = (
    0,   0,   0,    0,
    $80, 0,   0,    0,
    0,   $80, 0,    0,
    $80, $80, 0,    0,
    0,   0,   $80,  0,
    $80, 0,   $80,  0,
    0,   $80, $80,  0,
    $C0, $C0, $C0,  0,

    192, 220, 192,  0,
    166, 202, 240,  0,
    255, 251, 240,  0,
    160, 160, 164,  0,

    $80, $80, $80,  0,
    $FF, 0,   0,    0,
    0,   $FF, 0,    0,
    $FF, $FF, 0,    0,
    0,   0,   $FF,  0,
    $FF, 0,   $FF,  0,
    0,   $FF, $FF,  0,
    $FF, $FF, $FF,  0);

function ComponentFromIndex(i,nbits,shift : Dword) : Byte;
var
  val : Byte;
begin
  val:=Byte(i shr shift);
  case nbits of
    1:
      begin
        val := val and $01;
        ComponentFromIndex := oneto8[val];
      end;
    2:
      begin
        val := val and $03;
        ComponentFromIndex :=twoto8[val];
      end;
    3:
      begin
        val := val and $07;
        ComponentFromIndex:=threeto8[val];
      end;
  else
       ComponentFromIndex:=0;
  end;
end;

procedure DescribePFD(var PFD:TPixelFormatDescriptor;Lines:TStrings);
var
  s : string;
begin
  Lines.Add('  PFD.nSize: '+IntToStr(PFD.nSize));
  Lines.Add('  PFD.nVersion: '+IntToStr(PFD.nVersion));
  s:='';
  if((PFD.dwFlags and PFD_DRAW_TO_WINDOW)<>0) then
    s:=s+'& PFD_DRAW_TO_WINDOW ';
  if((PFD.dwFlags and PFD_DRAW_TO_BITMAP)<>0) then
    s:=s+'& PFD_DRAW_TO_BITMAP ';
  if((PFD.dwFlags and PFD_SUPPORT_GDI)<>0) then
    s:=s+'& PFD_SUPPORT_GDI ';
  if((PFD.dwFlags and PFD_SUPPORT_OPENGL)<>0) then
    s:=s+'& PFD_SUPPORT_OPENGL ';
  if((PFD.dwFlags and PFD_GENERIC_ACCELERATED)<>0) then
    s:=s+'& PFD_GENERIC_ACCELERATED ';
  if((PFD.dwFlags and PFD_GENERIC_FORMAT)<>0) then
    s:=s+'& PFD_GENERIC_FORMAT ';
  if((PFD.dwFlags and PFD_NEED_PALETTE)<>0) then
    s:=s+'& PFD_NEED_PALETTE ';
  if((PFD.dwFlags and PFD_NEED_SYSTEM_PALETTE)<>0) then
    s:=s+'& PFD_NEED_SYSTEM_PALETTE ';
  if((PFD.dwFlags and PFD_DOUBLEBUFFER)<>0) then
    s:=s+'& PFD_DOUBLEBUFFER ';
  if((PFD.dwFlags and PFD_STEREO)<>0) then
    s:=s+'& PFD_STEREO ';
  if((PFD.dwFlags and PFD_SWAP_LAYER_BUFFERS)<>0) then
    s:=s+'& PFD_SWAP_LAYER_BUFFERS ';
  if((PFD.dwFlags and PFD_DEPTH_DONTCARE)<>0) then
    s:=s+'& PFD_DEPTH_DONTCARE ';
  if((PFD.dwFlags and PFD_DOUBLEBUFFER_DONTCARE)<>0) then
    s:=s+'& PFD_DOUBLEBUFFER_DONTCARE ';
  if((PFD.dwFlags and PFD_STEREO_DONTCARE)<>0) then
    s:=s+'& PFD_STEREO_DONTCARE ';
  if((PFD.dwFlags and PFD_SWAP_COPY)<>0) then
    s:=s+'& PFD_SWAP_COPY ';
  if((PFD.dwFlags and PFD_SWAP_EXCHANGE)<>0) then
    s:=s+'& PFD_SWAP_EXCHANGE ';
  Lines.Add('  PFD.dwFlags: '+s);

  if(PFD.iPixelType=PFD_TYPE_RGBA) then
    s:='PFD_TYPE_RGBA'
  else
    s:='PFD_TYPE_COLORINDEX';
  Lines.Add('  PFD.iPixelType: '+s);

  Lines.Add('  PFD.cColorBits: '+IntToStr(PFD.cColorBits));
  Lines.Add('  PFD.cRedBits: '+IntToStr(PFD.cRedBits));
  Lines.Add('  PFD.cRedShift: '+IntToStr(PFD.cRedShift));
  Lines.Add('  PFD.cGreenBits: '+IntToStr(PFD.cGreenBits));
  Lines.Add('  PFD.cGreenShift: '+IntToStr(PFD.cGreenShift));
  Lines.Add('  PFD.cBlueBits: '+IntToStr(PFD.cBlueBits));
  Lines.Add('  PFD.cBlueShift: '+IntToStr(PFD.cBlueShift));
  Lines.Add('  PFD.cAlphaBits: '+IntToStr(PFD.cAlphaBits));
  Lines.Add('  PFD.cAlphaShift: '+IntToStr(PFD.cAlphaShift));
  Lines.Add('  PFD.cAccumBits: '+IntToStr(PFD.cAccumBits));
  Lines.Add('  PFD.cAccumRedBits: '+IntToStr(PFD.cAccumRedBits));
  Lines.Add('  PFD.cAccumGreenBits: '+IntToStr(PFD.cAccumGreenBits));
  Lines.Add('  PFD.cAccumBlueBits: '+IntToStr(PFD.cAccumBlueBits));
  Lines.Add('  PFD.cAccumAlphaBits: '+IntToStr(PFD.cAccumAlphaBits));
  Lines.Add('  PFD.cDepthBits: '+IntToStr(PFD.cDepthBits));
  Lines.Add('  PFD.cStencilBits: '+IntToStr(PFD.cStencilBits));
  Lines.Add('  PFD.cAuxBuffers: '+IntToStr(PFD.cAuxBuffers));
  Lines.Add(Format('  %d overlay planes, %d underlay planes.',
    [PFD.bReserved and $F,(PFD.bReserved and $F0) shr 4]));
  Lines.Add('  PFD.dwVisibleMask: '+IntToStr(PFD.dwVisibleMask));
end;

procedure DescribeRender(Lines:TStrings);
begin
  Lines.Add('GL_VERSION: '+String(glGetString(GL_VERSION)));
  Lines.Add('GL_VENDOR: '+String(PChar(glGetString(GL_VENDOR))));
  Lines.Add('GL_RENDERER: '+String(glGetString(GL_RENDERER)));
  Lines.Add('GL_EXTENSIONS: '+String(glGetString(GL_EXTENSIONS)));
end;

// =======================================================================
// GLCreate
// =======================================================================

procedure TOpenGLWindow.GLCreate;
var
  pfd     : TPIXELFORMATDESCRIPTOR;
  pPal    : PLOGPALETTE;
  dc      : HDC;
  hRC     : HGLRC;
  n,i,i4  : integer;
  iPixFmt : integer;
begin
  if(AppSetup.GLFlags.ShowLog) then GLStateForm.Show;
  GLStateForm.Log.Lines.Add(
    '===============   GLCreate(): '+GetSystemTimeStr);
  Time:=Windows.GetTickCount;
  PreviousTime:=Time;
  FrameCount:=0;
  Scene:=TOpenGLScene.Create;
  Scene.Mode:=modeNotInitialized;
  PauseRedraw:=True;
  PaletteNeeded:=False;
  Palette:=HPALETTE(0);
  OldPalette:=HPALETTE(0);
  OldIdleHandler:=nil;
  // Создать контекст вывода
  dc:=Windows.GetDC(Handle);

  GLStateForm.Log.Lines.Add('Создание контекста по дескриптору '+
    IntToStr(Handle));

  memZeroMemory(@pfd,sizeof(TPIXELFORMATDESCRIPTOR));
  pfd.nSize:=sizeof(TPIXELFORMATDESCRIPTOR);
  pfd.nVersion:=1;
  pfd.dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or
    PFD_DOUBLEBUFFER or PFD_GENERIC_ACCELERATED;
  pfd.iPixelType:=PFD_TYPE_RGBA;
  pfd.cDepthBits:=16;
  pfd.iLayerType:=PFD_MAIN_PLANE;
  (* 14 may 2012 просим альфа-канал в буфере кадра, чтобы не сортировать *)
  pfd.cAlphaBits:=1;
  if(AppSetup.GLFlags.DescribePFDs) then
  begin
    GLStateForm.Log.Lines.Add('Требуемый формат пиксела:');
    DescribePFD(pfd,GLStateForm.Log.Lines);
  end;

  iPixFmt:=Windows.ChoosePixelFormat(dc,@pfd);
  if(iPixFmt<>0)then
  begin
    GLStateForm.Log.Lines.Add(Format(
      'ChoosePixelFormat(): номер формата = %d.',[iPixFmt]));
    if(Windows.SetPixelFormat(dc,iPixFmt,@pfd)<>False) then
    begin
      GLStateForm.Log.Lines.Add('SetPixelFormat(): успех.');
      n:=Windows.GetPixelFormat(dc);
      if(Windows.DescribePixelFormat(dc,n,sizeof(TPIXELFORMATDESCRIPTOR),
        pfd)<>False) then
      begin
        if(AppSetup.GLFlags.DescribePFDs) then
        begin
          GLStateForm.Log.Lines.Add('Ближайший формат пиксела:');
          DescribePFD(pfd,GLStateForm.Log.Lines);
          if pfd.cAlphaBits = 0 then
            GLStateForm.Log.Lines.Add('Упс, девайс не поддержиывает DST_ALPHA, прозрачность работать правильно не будет!')
          else
            GLStateForm.Log.Lines.Add('Девайс поддержиывает DST_ALPHA.')
        end;
        if((pfd.dwFlags and PFD_GENERIC_FORMAT)<>0) then
        begin
          GLStateForm.Log.Lines.Add(
            'Графический акселератор не задействован.');
        end
        else
        begin
          GLStateForm.Log.Lines.Add(
            'Задействован графический акселератор.');
        end;

        if((pfd.dwFlags and PFD_NEED_PALETTE)<>0) then
        begin
          PaletteNeeded:=True;
          n := 1 shl pfd.cColorBits;
          GetMem(pPal,sizeof(TLOGPALETTE)+n*sizeof(TPALETTEENTRY));
          pPal^.palVersion:=$300;
          pPal^.palNumEntries:=n;
          for i:=0 to n-1 do
          begin
            pPal^.palPalEntry[i].peRed :=
              ComponentFromIndex(i, pfd.cRedBits, pfd.cRedShift);
            pPal^.palPalEntry[i].peGreen :=
              ComponentFromIndex(i, pfd.cGreenBits, pfd.cGreenShift);
            pPal^.palPalEntry[i].peBlue :=
              ComponentFromIndex(i, pfd.cBlueBits, pfd.cBlueShift);
            pPal^.palPalEntry[i].peFlags := 0;
          end;
          if (pfd.cColorBits=8) and (pfd.cRedBits=3) and (pfd.cRedShift=0) and
             (pfd.cGreenBits=3) and (pfd.cGreenShift=3) and
             (pfd.cBlueBits=2) and (pfd.cBlueShift=6) then
          begin
            for i:=1 to 12 do
            begin
              i4:=i shl 2;
              pPal^.palPalEntry[defaultOverride[i]].peRed :=
                defaultPalEntry[i4];
              pPal^.palPalEntry[defaultOverride[i]].peGreen :=
                defaultPalEntry[i4+1];
              pPal^.palPalEntry[defaultOverride[i]].peBlue :=
                defaultPalEntry[i4+2];
              pPal^.palPalEntry[defaultOverride[i]].peFlags :=
                defaultPalEntry[i4+3];
            end;
          end;
          Palette:=Windows.CreatePalette(pPal^);
          FreeMem(pPal);
          OldPalette:=Windows.SelectPalette(dc,Palette,False);
          Windows.RealizePalette(dc);
          GLStateForm.Log.Lines.Add('Создана палитра.');
        end;
        hRC:=Windows.wglCreateContext(dc);
        if(hRC<>0) then
        begin
          if(Windows.wglMakeCurrent(dc,hRC)) then
          begin
            GLStateForm.Log.Lines.Add('Инициализация завершена. Драйвер:');
            DescribeRender(GLStateForm.Log.Lines);
            Scene.Mode:=modeGame;
            OpenGL.glClearDepth(1);
            OpenGL.glDepthFunc(GL_LESS);
            OpenGL.glPixelStorei(GL_UNPACK_LSB_FIRST,GL_FALSE);
            OpenGL.glPixelStorei(GL_UNPACK_ALIGNMENT,1);
            Scene.Initialize;
            Scene.FPS:=0;
            GLResize(Self);
          end // wglMakeCurrent
          else
          begin
            GLStateForm.Log.Lines.Add('Ошибка wglMakeCurrent(): '+
              MessageFromSystem);
          end;
        end // wglCreateContext
        else
        begin
          GLStateForm.Log.Lines.Add('Ошибка wglCreateContext(): '+
            MessageFromSystem);
        end;
      end  // DescribePixelFormat
      else
      begin
        GLStateForm.Log.Lines.Add('Ошибка DescribePixelFormat(): '+
          MessageFromSystem);
      end;
    end  // SetPixelFormat
    else
    begin
      GLStateForm.Log.Lines.Add('Ошибка SetPixelFormat(): '+
        MessageFromSystem);
    end;
  end // ChoosePixelFormat
  else
  begin
    GLStateForm.Log.Lines.Add('Ошибка ChoosePixelFormat(): '+
      MessageFromSystem);
  end;
  if(Scene.Mode<>modeGame) then
  begin
    Windows.ReleaseDC(Handle,dc);
  end;
  GLStateForm.Log.Lines.Add(
    '=============   Вызов GLCreate() завершен  =============');
  if(AppSetup.GLFlags.ShowLog) then GLStateForm.Close;
end;

// =======================================================================
// GLQueryNewPalette
// =======================================================================

procedure TOpenGLWindow.GLQueryNewPalette;
var
  dc : HDC;
begin
  if(PaletteNeeded and (Scene.Mode<>modeNotInitialized)) then
  begin
    if(Palette <> 0) then
    begin
      dc:=Windows.GetDC(Handle);
      OldPalette:=Windows.SelectPalette(dc,Palette,False);
      Windows.RealizePalette(dc);
      Invalidate;
      if OldPalette <> 0 then
        Windows.SelectPalette(dc,OldPalette,False);
      Windows.ReleaseDC(Handle,dc);
    end;
  end;
end;

// =======================================================================
// GLPaletteChanged
// =======================================================================

procedure TOpenGLWindow.GLPaletteChanged;
var
  dc : HDC;
begin
  if(PaletteNeeded and (Scene.Mode<>modeNotInitialized)) then
  begin
    if(Msg.WParam = WPARAM(Handle)) then exit;
    if(Palette <> 0) then
    begin
      dc:=Windows.GetDC(Handle);
      OldPalette:=Windows.SelectPalette(dc,Palette,False);
      Windows.RealizePalette(dc);
      Windows.UpdateColors(dc);
      Invalidate;
      if OldPalette <> 0 then
        Windows.SelectPalette(dc,OldPalette,False);
      Windows.ReleaseDC(Handle,dc);
    end;
  end;
end;

// =======================================================================
// Поведение окна - исходя из необходимости непрерывной перерисовки
// =======================================================================

procedure TOpenGLWindow.GLEraseBkgnd;
begin
  Msg.Result:=LRESULT(False);
end;

procedure TOpenGLWindow.GLEnterMenuLoop;
begin
  PrevMode:=Scene.Mode;
  Pause;
end;

procedure TOpenGLWindow.GLEnterSizeMove;
begin
  PrevMode:=Scene.Mode;
  Pause;
end;

procedure TOpenGLWindow.GLExitMenuLoop;
begin
  Scene.Mode:=PrevMode;
  // Существует одна ситуация, которая не позволяет достоверно определить
  // предыдущее остояние. Именно, если контекстное меню дочернего MDI -
  // окна активировано при перемещении по меню родительского окна, то
  // событие WM_ENTERMENULOOP для него не возникает.
  if(Scene.Mode=modeNotInitialized) then
  begin
    if((Scene<>nil)and(wglGetCurrentContext<>0)) then 
      Scene.Mode:=modeGame;
  end;
  Time:=GetTickCount;
  PreviousTime:=Time;
end;

procedure TOpenGLWindow.GLExitSizeMove;
begin
  Scene.Mode:=PrevMode;
  Time:=GetTickCount;
  PreviousTime:=Time;
end;

// =======================================================================
// GLDestroy
// =======================================================================

procedure TOpenGLWindow.GLDestroy;
var
  dc  : HDC;
  hRc : HGLRC;
begin
  if(AppSetup.GLFlags.ShowLog) then GLStateForm.Show;
  GLStateForm.Log.Lines.Add('===============   GLDestroy(): '
    +GetSystemTimeStr);
  if(Scene<>nil) then
  begin
    Scene.Finalize;
    Scene.Mode:=modeNotInitialized;
    Scene.Destroy;
    Scene:=nil;
  end;
  hRc:=Windows.wglGetCurrentContext();
  dc:=Windows.wglGetCurrentDC();
  Windows.wglMakeCurrent(0,0);
  if(hrc <> 0) then
  begin
    Windows.wglDeleteContext(hrc);
    GLStateForm.Log.Lines.Add(Format('Контекст %d (OpenGL) удален.',
      [hrc]));
  end;
  if(dc <> 0) then
  begin
    Windows.ReleaseDC(Handle,dc);
    GLStateForm.Log.Lines.Add(Format('Контекст %d (GDI) удален.',[dc]));
  end;
  OldPalette:=0;
  Palette:=0;
  GLStateForm.Log.Lines.Add(
    '===============  Вызов GLDestroy() завершен ===============');
  if(AppSetup.GLFlags.ShowLog) then GLStateForm.Close;
end;

// =======================================================================
// GLShow
// =======================================================================
procedure TOpenGLWindow.GLShow(Sender: TObject);
begin
  GLCreate;
  if(Scene.Mode=modeNotInitialized) then exit;
  OldIdleHandler:=Application.OnIdle;
  OldDeactivateHandler:=Application.OnDeactivate;
  OldActivateHandler:=Application.OnActivate;
  Application.OnIdle:=ApplicationIdle;
  Application.OnDeactivate:=GLDeactivate;
  Application.OnActivate:=GLActivate;
  GLAdjustDisplayMenu;
  FPSTimer.Enabled:=True;
end;

// =======================================================================
// FormCreate
// =======================================================================

procedure TOpenGLWindow.FormCreate(Sender: TObject);
begin
  NotifyGLClose:=nil;
  Scene:=nil;
end;

// =======================================================================
// FormClose
// =======================================================================

procedure TOpenGLWindow.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if(@NotifyGLClose<>nil) then
    NotifyGLClose(Self);
  FPSTimer.Enabled:=False;
  Application.OnIdle:=OldIdleHandler;
  Application.OnDeactivate:=OldDeactivateHandler;
  Application.OnActivate:=OldActivateHandler;
  GLDestroy;
  Action:=caFree;
end;

// =======================================================================
// GLResize
// =======================================================================

procedure TOpenGLWindow.GLResize(Sender: TObject);
begin
  if((Scene<>nil)and(Scene.Mode<>modeNotInitialized)) then
  begin
    Scene.AdjustViewportFrustum(ClientRect);
    Invalidate;
  end;
end;

// =======================================================================
// ApplicationIdle
// =======================================================================

procedure TOpenGLWindow.ApplicationIdle;
begin
  if((Scene.Mode<>modeGame)or(Windows.IsIconic(Handle))) then
  begin
    InitialDraw;
    Done:=True;
  end
  else
  begin
    InitialDraw;
    Done:=False;
  end;
end;

procedure TOpenGLWindow.FPSTimerTimer(Sender: TObject);
begin
  if(Scene<>nil) then Scene.FPS:=FrameCount;
  FrameCount:=0;
end;

procedure TOpenGLWindow.Pause;
begin
  if(Scene=nil) then exit;
  if(Scene.Mode=modeNotInitialized) then exit;
  Scene.Mode:=modePaused;
  PauseRedraw:=True;
  InitialDraw;
end;

procedure TOpenGLWindow.Resume;
begin
  if(Scene=nil) then exit;
  if(Scene.Mode=modeNotInitialized) then exit;
  Scene.Mode:=modeGame;
  Time:=GetTickCount;
  PreviousTime:=Time;
  PauseRedraw:=True;
  InitialDraw;
end;

procedure TOpenGLWindow.GLDisplayChange;
begin
  GLDestroy;
  GLCreate;
  GLAdjustDisplayMenu;
end;

procedure TOpenGLWindow.GLAdjustDisplayMenu;
var
  cx : integer;
begin
  cx:=Windows.GetSystemMetrics(SM_CXSCREEN);
  if(cx<1600) then
    Item1600X1200.Enabled:=False
  else
    Item1600X1200.Enabled:=True;
  if(cx<1280) then
    Item1280X1024.Enabled:=False
  else
    Item1280X1024.Enabled:=True;
  if(cx<1024) then
    Item1024X768.Enabled:=False
  else
    Item1024X768.Enabled:=True;
  if(cx<960) then
    Item960X720.Enabled:=False
  else
    Item960X720.Enabled:=True;
  if(cx<800) then
    Item800X600.Enabled:=False
  else
    Item800X600.Enabled:=True;
end;

procedure TOpenGLWindow.FormPaint(Sender: TObject);
begin
  PauseRedraw:=True;
  InitialDraw;
end;

procedure TOpenGLWindow.GLDeactivate(Sender: TObject);
begin
  Pause;
end;

procedure TOpenGLWindow.GLActivate(Sender: TObject);
begin
  Resume;
end;

procedure TOpenGLWindow.Item320X240Click(Sender: TObject);
begin
  if(Item320X240.Checked) then exit;
  ClientWidth:=320;
  ClientHeight:=240;
  GLResize(nil);
  Item320X240.Checked:=True;
end;

procedure TOpenGLWindow.Item400X300Click(Sender: TObject);
begin
  if(Item400X300.Checked) then exit;
  ClientWidth:=400;
  ClientHeight:=300;
  GLResize(nil);
  Item400X300.Checked:=True;
end;

procedure TOpenGLWindow.Item480X360Click(Sender: TObject);
begin
  if(Item480X360.Checked) then exit;
  ClientWidth:=480;
  ClientHeight:=360;
  GLResize(nil);
  Item480X360.Checked:=True;
end;

procedure TOpenGLWindow.Item512X384Click(Sender: TObject);
begin
  if(Item512X384.Checked) then exit;
  ClientWidth:=512;
  ClientHeight:=384;
  GLResize(nil);
  Item512X384.Checked:=True;
end;

procedure TOpenGLWindow.Item640X480Click(Sender: TObject);
begin
  if(Item640X480.Checked) then exit;
  ClientWidth:=640;
  ClientHeight:=480;
  GLResize(nil);
  Item640X480.Checked:=True;
end;

procedure TOpenGLWindow.Item800X600Click(Sender: TObject);
begin
  if(Item800X600.Checked) then exit;
  ClientWidth:=800;
  ClientHeight:=600;
  GLResize(nil);
  Item800X600.Checked:=True;
end;

procedure TOpenGLWindow.Item960X720Click(Sender: TObject);
begin
  if(Item960X720.Checked) then exit;
  ClientWidth:=960;
  ClientHeight:=720;
  GLResize(nil);
  Item960X720.Checked:=True;
end;

procedure TOpenGLWindow.Item1024X768Click(Sender: TObject);
begin
  if(Item1024X768.Checked) then exit;
  ClientWidth:=1024;
  ClientHeight:=768;
  GLResize(nil);
  Item1024X768.Checked:=True;
end;

procedure TOpenGLWindow.Item1280X1024Click(Sender: TObject);
begin
  if(Item1280X1024.Checked) then exit;
  ClientWidth:=1280;
  ClientHeight:=1024;
  GLResize(nil);
  Item1280X1024.Checked:=True;
end;

procedure TOpenGLWindow.Item1600X1200Click(Sender: TObject);
begin
  if(Item1600X1200.Checked) then exit;
  ClientWidth:=1600;
  ClientHeight:=1200;
  GLResize(nil);
  Item1600X1200.Checked:=True;
end;

procedure TOpenGLWindow.InitialDraw;
begin
  if(Scene=nil) then exit;
  case Scene.Mode of
    modeNotInitialized:
    begin
      Windows.PatBlt(Canvas.Handle,0,0,ClientWidth,ClientHeight,BLACKNESS);
      Canvas.Pen.Color:=clWhite;
      Canvas.MoveTo(0,0);
      Canvas.LineTo(ClientWidth-1,ClientHeight-1);
      Canvas.MoveTo(0,ClientHeight-1);
      Canvas.LineTo(ClientWidth-1,0);
      Canvas.Font.Color:=clWhite;
      Canvas.TextOut(5,5,'(Ошибка интерфейса OpenGL)');
      exit;
    end;
    modeGame:
    begin
      Time:=GetTickCount;
      Scene.Control(PreviousTime,Time);
      Scene.Draw(PreviousTime,Time);
      PreviousTime:=Time;
      if(GetFocus<>Handle) then
      begin
        Pause;
      end;
    end;
    modePaused:
    begin
      Time:=GetTickCount;
      PreviousTime:=Time;
      if(PauseRedraw) then
      begin
        Scene.Draw(PreviousTime,Time);
        PauseRedraw:=False;
      end;
      if(GetFocus=Handle) then
      begin
        Resume;
      end;

      {if((GetAsyncKeyState(VK_PAUSE) and 1)<>0) then
      begin
        Scene.Mode:=modeGame;
      end;}
    end;
    modeMenu:
    begin
      Time:=GetTickCount;
      PreviousTime:=Time;
      Scene.Draw(PreviousTime,Time);
    end;
  end;
  SwapBuffers(wglGetCurrentDC());
  FrameCount:=FrameCount+1;
  OpenGL.glFlush();
end;

procedure TOpenGLWindow.CaptureBuffer(var Dest:TBitmap);
type
  rgbarr = array[0..16000] of TRGBTRIPLE;
  prgbarr = ^rgbarr;
var
  i,j : integer;
  t   : byte;
  arr : prgbarr;
begin
  Dest.Width:=ClientRect.Right;
  Dest.Height:=ClientRect.Bottom;
  Dest.PixelFormat:=pf24bit;
  OpenGL.glReadPixels(0,0,ClientRect.Right,ClientRect.Bottom,GL_RGB,
    GL_UNSIGNED_BYTE,Dest.ScanLine[Dest.Height-1]);
  for i:=0 to Dest.Height-1 do
  begin
    arr:=prgbarr(Dest.Scanline[i]);
    for j:=0 to Dest.Width-1 do
    begin
      t:=arr^[j].rgbtBlue;
      arr^[j].rgbtBlue:=arr^[j].rgbtRed;
      arr^[j].rgbtRed:=t;
    end;
  end;
end;

procedure TOpenGLWindow.DrawToBitmap(var Dest:TBitmap);
var
  pfd     : TPIXELFORMATDESCRIPTOR;
  iPixFmt : integer;
  DrawTime: integer;
  oldRC   : HGLRC;
  oldDC   : HDC;
  bitRC   : HGLRC;
  Rc      : TRect;
  lns     : TStrings;
begin
  WindowState:=wsMinimized;
  if(AppSetup.GLFlags.ShowLog) then GLStateForm.Show;
  GLStateForm.Log.Lines.Add(
    '===============   DrawToBitmap(): '+GetSystemTimeStr);
  Assert((Dest.Width>0)and(Dest.Height>0));
  Dest.PixelFormat:=pf24bit;
  // Создаем битовый контекст
  oldRC:=wglGetCurrentContext;
  oldDC:=wglGetCurrentDC;
  memZeroMemory(@pfd,sizeof(TPIXELFORMATDESCRIPTOR));
  pfd.nSize:=sizeof(TPIXELFORMATDESCRIPTOR);
  pfd.nVersion:=1;
  pfd.dwFlags:=PFD_DRAW_TO_BITMAP or PFD_SUPPORT_OPENGL;
  pfd.iPixelType:=PFD_TYPE_RGBA;
  pfd.cDepthBits:=32;
  pfd.cColorBits:=24;
  pfd.cAlphaBits:=8;
  pfd.iLayerType:=PFD_MAIN_PLANE;
  if(AppSetup.GLFlags.DescribePFDs) then
  begin
    GLStateForm.Log.Lines.Add('Требуемый формат пиксела:');
    DescribePFD(pfd,GLStateForm.Log.Lines);
  end;
  iPixFmt:=Windows.ChoosePixelFormat(Dest.Canvas.Handle,@pfd);
  if(iPixFmt=0) then
  begin
    GLStateForm.Log.Lines.Add('Ошибка ChoosePixelFormat(): '+
      MessageFromSystem);
    if(AppSetup.GLFlags.ShowLog) then GLStateForm.Close;
    WindowState:=wsNormal;
    exit;
  end;
  GLStateForm.Log.Lines.Add('Номер формата: '+IntToStr(iPixFmt));
  // Я не знаю почему это происходит, но начиная от этого вызова на
  // экран больше ничего выводить нельзя !
  if(Windows.SetPixelFormat(Dest.Canvas.Handle,iPixFmt,@pfd)=False) then
  begin
    GLStateForm.Log.Lines.Add('Ошибка SetPixelFormat(): '+
      MessageFromSystem);
    if AppSetup.GLFlags.ShowLog then
      GLStateForm.Close;
    WindowState:=wsNormal;
    exit;
  end;
  lns:=TStringList.Create;
  bitRC:=Windows.wglCreateContext(Dest.Canvas.Handle);
  if(bitRC<>0) then
  begin
    if(Windows.wglMakeCurrent(Dest.Canvas.Handle,bitRC)<>False) then
    begin
      Rc.Left:=0;
      Rc.Right:=Dest.Width-1;
      Rc.Top:=0;
      Rc.Bottom:=Dest.Height-1;
      OpenGL.glClearDepth(1);
      OpenGL.glDepthFunc(GL_LESS);
      OpenGL.glPixelStorei(GL_UNPACK_LSB_FIRST,GL_FALSE);
      OpenGL.glPixelStorei(GL_UNPACK_ALIGNMENT,1);
      Scene.AdjustViewportFrustum(Rc);
      DrawTime:=GetTickCount;
      Scene.Draw(Time,Time);
      DescribeRender(lns);
      wglMakeCurrent(oldDC,oldRC);
      GLResize(Self);
      GLStateForm.Log.Lines.Add('Сцена нарисована за '+
        IntToStr(GetTickCount-DrawTime)+' миллисекунд драйвером:');
      GLStateForm.Log.Lines.AddStrings(lns);
    end
    else
    begin
      GLStateForm.Log.Lines.Add('Ошибка wglMakeCurrent(): '+
        MessageFromSystem);
    end;
    wglDeleteContext(bitRC);
    GLStateForm.Log.Lines.Add('Контекст '+IntToStr(bitRC)+' удален.');
  end
  else
  begin
    GLStateForm.Log.Lines.Add('Ошибка wglCreateContext(): '+
      MessageFromSystem);
  end;
  GLStateForm.Log.Lines.Add(
    '=============   Вызов DrawToBitmap() завершен  =============');
  if(AppSetup.GLFlags.ShowLog) then GLStateForm.Close;
  lns.Free;
  WindowState:=wsNormal;
end;

procedure TOpenGLWindow.FormHide(Sender: TObject);
begin
  if((Scene<>nil)and(Scene.Mode<>modeNotInitialized)) then
  begin
    FPSTimer.Enabled:=False;
    Application.OnIdle:=OldIdleHandler;
    Application.OnDeactivate:=OldDeactivateHandler;
    Application.OnActivate:=OldActivateHandler;
    GLDestroy;
  end;
end;

procedure TOpenGLWindow.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
  45: // Home
    begin
      if(Scene<>nil) then
        Scene.KeyController.ResetPosition;
    end;
  end;
  if(Scene<>nil) then
    Scene.HandleKey(Key,Shift);
end;

procedure TOpenGLWindow.CaptureItemClick(Sender: TObject);
var
  BMP : TBitmap;
begin
  PrevMode:=Scene.Mode;
  Pause;
  if(SaveDialog.Execute) then
  begin
    BMP:=TBitmap.Create;
    CaptureBuffer(bmp);
    BMP.SaveToFile(SaveDialog.FileName);
    BMP.Free;
  end;
  if(PrevMode=modeGame) then
    Resume;
end;

procedure TOpenGLWindow.BitDrawItemClick(Sender: TObject);
var
  BMP : TBitmap;
begin
  PrevMode:=Scene.Mode;
  Pause;
  GLBitSize.ShowModal;
  if(GLBitSize.ModalResult=mrOk) then
  begin
    if(SaveDialog.Execute) then
    begin
      BMP:=TBitmap.Create;
      BMP.Width:=GLBitSize.SEWidth.Value;
      BMP.Height:=GLBitSize.SEHeight.Value;
      DrawToBitmap(BMP);
      BMP.SaveToFile(SaveDialog.FileName);
      BMP.Free;
    end;
  end;
  if(PrevMode=modeGame) then
    Resume;
end;

procedure TOpenGLWindow.FormDeactivate(Sender: TObject);
begin
  if(Scene<>nil) then
  begin
    PrevMode:=Scene.Mode;
    Pause;
  end
  else
    PrevMode:=modeNotInitialized;
end;

procedure TOpenGLWindow.FormActivate(Sender: TObject);
begin
  if(PrevMode=modeGame) then
    Resume;
end;

procedure TOpenGLWindow.OGLMenuClick(Sender: TObject);
begin
  WindowSizeMenu.Enabled:=not (WindowState=wsMaximized);
end;

procedure TOpenGLWindow.LogItemClick(Sender: TObject);
begin
  GLStateForm.ShowModal;
end;

procedure TOpenGLWindow.SetupChanged;
begin
  Invalidate;
  if(Scene<>nil) then
  begin
    Scene.ChangeControlMode;
  end;
end;

procedure TOpenGLWindow.FormatItemClick(Sender: TObject);
begin
  OptionsForm.PCOptions.ActivePage:=OptionsForm.GLSheet;
  OptionsForm.ShowModal;
end;

procedure TOpenGLWindow.ResetPosItemClick(Sender: TObject);
begin
  if(Scene<>nil) then
    Scene.KeyController.ResetPosition;
end;

end.

