pascal - проблема с opengl

[Disaster1986]

Нашел в инете вот такой код:

(Нажмите, чтобы показать/скрыть)

Код: [Выделить]

program Demo01;
uses
  GL, GLU, GLX, X, XLib, XUtil;

const
  wnd_Width  = 800;
  wnd_Height = 600;
var
  scr_Display    : PDisplay;
  scr_Default    : DWORD;
  scr_ColorMap   : TColorMap;
  wnd_Handle     : TWindow;
  wnd_Root       : TWindow;
  wnd_Attr       : TXSetWindowAttributes;
  wnd_ValueMask  : DWORD;
  wnd_Caption    : PChar;
  wnd_Title      : TXTextProperty;
  ogl_Context    : GLXContext;
  ogl_VisualInfo : PXVisualInfo;
  ogl_Attr       : array[ 0..10 ] of DWORD;
  Event          : TXEvent;

procedure connectXServer;
begin
  scr_Display := XOpenDisplay( nil );
  if not Assigned( scr_Display ) Then
    begin
      // Ошибка
      exit;
    end;
  scr_Default := DefaultScreen( scr_Display );
end;

procedure CreateWindow( X, Y, Width, Height : Integer );
begin
  wnd_Root := RootWindow( scr_Display, ogl_VisualInfo^.screen ); // Получаем идентификатор root-окна
  // Создаем colormap
  scr_ColorMap := XCreateColormap( scr_Display, wnd_Root, ogl_VisualInfo^.visual, AllocNone );

  wnd_Attr.colormap   := scr_ColorMap;
  wnd_Attr.event_mask := ExposureMask or StructureNotifyMask;
  wnd_ValueMask       := CWColormap or CWEventMask or CWX or CWY;

  wnd_Handle := XCreateWindow( scr_Display,
                               wnd_Root,
                               X, Y,// X, Y окна
                               Width, Height,// Ширина/Высота окна
                               0, // Ширина рамки
                               ogl_VisualInfo^.depth,
                               InputOutput, // Окно будет на ввод/вывод
                               ogl_VisualInfo^.visual,
                               wnd_ValueMask,
                               @wnd_Attr );
                            
  if wnd_Handle = 0 Then
    begin
      // Ошибка
      exit;
    end;
  
  XMapWindow( scr_Display, wnd_Handle );
  glXWaitX;
end;

procedure DestroyWindow;
begin
  XDestroyWindow( scr_Display, wnd_Handle );
  glXWaitX;
end;

procedure ChooseVisual;
begin
  ogl_Attr[ 0 ] := GLX_RGBA;
  ogl_Attr[ 1 ] := GLX_DOUBLEBUFFER;
  ogl_Attr[ 2 ] := GLX_DEPTH_SIZE;
  ogl_Attr[ 3 ] := 24;
  ogl_Attr[ 4 ] := GLX_STENCIL_SIZE;
  ogl_Attr[ 5 ] := 8;
  ogl_Attr[ 6 ] := None;

  ogl_VisualInfo := glXChooseVisual( scr_Display, scr_Default, @ogl_Attr );
  if not Assigned( ogl_VisualInfo ) Then
    begin
      // Ошибка
      exit;
    end;
end;

procedure CreateGLContext;
begin
  // пробуем Direct Render
  ogl_Context := glXCreateContext( scr_Display, ogl_VisualInfo, nil, TRUE );
  if not Assigned( ogl_Context ) Then
    begin
      // пробуем Indirect Render
      ogl_Context := glXCreateContext( scr_Display, ogl_VisualInfo, nil, FALSE );
      if not Assigned( ogl_Context ) Then
        begin
          // Ошибка
          exit;
        end;
    end;
    
  if not glXMakeCurrent( scr_Display, wnd_Handle, ogl_Context ) Then
    begin
      // Ошибка
      exit;
    end;
end;

procedure DestroyGLContext;
begin
  if not glXMakeCurrent( scr_Display, None, nil ) Then; // Ошибка

  glXDestroyContext( scr_Display, ogl_Context );
  glXWaitGL;
end;

Begin
  connectXServer;
  ChooseVisual;
  CreateWindow( 0, 0, wnd_Width, wnd_Height );
  CreateGLContext;

  // Установим заголовок для окна
  wnd_Caption := 'Hello, World!'; // Заполняем строку именем
  XStringListToTextProperty( @wnd_Caption, 1, @wnd_Title ); // Заносим имя в специальную структуру
  XSetWMName( scr_Display, wnd_Handle, @wnd_Title ); // Устанавливаем имя заголовка

  glClearColor( 0, 0, 0, 0 );
  glHint( GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST );
  glDepthFunc ( GL_LEQUAL );
  glClearDepth( 1.0 );

  glViewport( 0, 0, wnd_Width, wnd_Height );

  glEnable( GL_DEPTH_TEST );
  glMatrixMode( GL_PROJECTION );
  glLoadIdentity;
  gluPerspective( 45, wnd_Width / wnd_Height, 0.1, 100 );
  glMatrixMode( GL_MODELVIEW );
  glLoadIdentity;

  while TRUE do
    begin
      while XPending( scr_Display ) <> 0 do
        begin
          XNextEvent( scr_Display, @Event );
        end;

      glColor3f( 1, 1, 1 );
      glBegin( GL_QUADS );
        glVertex3f( -1, -1, -3 );
        glVertex3f(  1, -1, -3 );
        glVertex3f(  1,  1, -3 );
        glVertex3f( -1,  1, -3 );
      glEnd;

      glFlush;
      glXWaitGL;
      glXSwapBuffers( scr_Display, wnd_Handle );
    end;

  DestroyGLContext;
  DestroyWindow;

  XFreeColormap( scr_Display, scr_ColorMap );
End.


Попробовал скомпилировать - получил вот такую красоту:


Проверил на ноуте - не компилится, говорит не может найти -lX11

Я, конечно же, прекрасно понимаю, что freepascal не для графики и вообще не нужен, но всё же в чём причина такого странного поведения?

(Нажмите, чтобы показать/скрыть)

На компе debian squeeze amd64, компилятор Free Pascal Compiler version 2.4.0-2 [2010/02/20] for x86_64. На ноуте Ubuntu 10.10 i386, версию компилятора не помню, если очень надо могу посмотреть

[dedm0zaj]

попробовал. код откомпилировался 1 в 1

[VitalD]

Disaster1986,
А что должно быть в идеале, а то у меня немного другой результат:

Пользователь решил продолжить мысль 09 Октября 2012, 20:58:17:в добавок к этому одно из ядер процессора полностью загружено 

[dedm0zaj]

немного потестил. нагружать проц заставляет glXWaitGL. её можно закаментить и будет норм.

также в проге отсутствует очистка очистка фона, т.е переде отрисовкой квадрата нужно добавить
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

в итоге нижняя часть кода получится такой:

Код: [Выделить]

while TRUE do
    begin
      while XPending( scr_Display ) <> 0 do
        begin
          XNextEvent( scr_Display, @Event );
        end;
     
      glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); //добавляем очистку экрана перед каждой отрисовкой

      glColor3f( 1, 1, 1 );
      glBegin( GL_QUADS );
        glVertex3f( -1, -1, -3 );
        glVertex3f(  1, -1, -3 );
        glVertex3f(  1,  1, -3 );
        glVertex3f( -1,  1, -3 );
      glEnd;

      glFlush;
      //glXWaitGL; //закоментируем
      glXSwapBuffers( scr_Display, wnd_Handle );
    end;

зы
что интересно, это то, что в паскале квадратик будет рисоваться с частотой, равной частоте монитора, и при этом проц не грузится. а в С++ такого ограничения нет, проц грузится и приходится в код отрисовки вставлять притормаживающие функции на подобии sleep с задержкой хотя бы в 1 мс.