воскресенье, 26 июля 2015 г.

Lazarus World. Порт приложения Particles "Частицы"

Очередная попытка порта приложения Particles "Частицы", которое было портировано с аналогичного приложения Particles "Частицы" написаного на языке программирование Delphi и с использованием библиотеки DelphiX (DirectX). Оригинальный код приложения, на основе которого сделан порт, взят сайта Delphi-Graphics. Код портирован на Lazarus с использованием OpenGL для отрисовки графики. Цель портирования - заставить работать приложение в операционной системе Ubuntu Linux. Код порта оставляю без комментарий, т. к. портирование проводилось без детального разбора работы алгоритма оригинального приложения и осуществлялся банальный подбор функций OpenGL и их параметров. На рисунке 1 предсталена работа портированного приложения в Ubuntu Linux.

Рисунок 1. Приложение «Частицы»

program lazarus_p2;

uses gl, glut, glu;

var
  ScreenWidth, ScreenHeight: Integer;
  SineMove : array[0..255] of integer; { Sine Table for Movement }
  CosineMove : array[0..255] of integer; { CoSine Table for Movement }
  SineTable : array[0..449] of integer; { Sine Table. 449 = 359 + 180 }
  CenterX, CenterY : Integer;
  LastUpdate: Integer;
const
  AppWidth = 640;
  AppHeight = 480;

procedure CalculateTables;
var
  wCount : Word;
begin
  { Precalculted Values for movement }

  for wCount := 0 to 255 do
  begin
    SineMove[wCount] := round( sin( pi*wCount/128 ) * 45 );
    CosineMove[wCount] := round( cos( pi*wCount/128 ) * 60 );
  end;

  { Precalculated Sine table. Only One table because cos(i) = sin(i + 90) }

  for wCount := 0 to 449 do
  begin
    SineTable[wCount] := round( sin( pi*wCount / 180 ) * 128);
  end;
end;



procedure PlotPoint(XCenter, YCenter, Radius, Angle: Word);
var
  X, Y : Word;

begin
  X := ( Radius * SineTable[90 + Angle]);

  {$ASMMODE intel}
  asm
     sar x, 7
  end;
  X := CenterX + XCenter + X;
  Y := ( Radius * SineTable[Angle] );
  asm
     sar y, 7
  end;

  Y := CenterY + YCenter + Y;
  if (X < AppWidth ) and ( Y < AppHeight ) then
  begin
  glBegin(GL_POINTS);
      glVertex2i(X, Y);
  glEnd;
  end;
end;



procedure DrawGLScene; cdecl;
const
  x : Word = 0;
  y : Word = 0;

  IncAngle = 12;

  XMove = 7;
  YMove = 8;

var
  CountAngle : Word;
  CountLong : Word;
  IncLong :Word;

begin
  glClear(GL_COLOR_BUFFER_BIT);

  IncLong := 2;
  CountLong := 20;

  { Draw Circle }

  repeat
    CountAngle := 0;
    repeat
      PlotPoint(CosineMove[( x + ( 200 - CountLong )) mod 255],
      SineMove[( y + ( 200 - CountLong )) mod 255], CountLong, CountAngle);
      inc(CountAngle, IncAngle);
    until CountAngle >= 360;

    { Another Circle, eventually another color }

    inc(CountLong, IncLong);

    if ( CountLong mod 3 ) = 0 then
    begin
      inc(IncLong);
    end;
  until CountLong >= 270;

  { move x and y co-ordinates}

  x := XMove + x mod 255;
  y := YMove + y mod 255;

  glutSwapBuffers;
end;

procedure ReSizeGLScene(Width, Height: Integer); cdecl;
begin
  glViewport(0, 0, Width, Height);
end;

procedure GLKeyboard(Key: Byte; X, Y: Longint); cdecl;
begin
  if Key = 27 then
    Halt(0);
end;

procedure InitializeGL;
begin
  glEnable( GL_POINT_SMOOTH );
  glColor3f(0, 0.3, 1);
  glPointSize(2);
  gluOrtho2D(0.0, 640.0, 0.0, 480.0);
  CenterX := AppWidth div 2;
  CenterY := AppHeight div 2;
  CalculateTables;
end;

begin
glutInit(@argc, argv);
glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGB or GLUT_DEPTH);
glutInitWindowSize(AppWidth, AppHeight);
ScreenWidth := glutGet(GLUT_SCREEN_WIDTH);
ScreenHeight := glutGet(GLUT_SCREEN_HEIGHT);

glutInitWindowPosition((ScreenWidth - AppWidth) div 2,(ScreenHeight - AppHeight) div 2);
glutCreateWindow('ogl_p1');

InitializeGL;

glutDisplayFunc(@DrawGLScene);
glutIdleFunc(@DrawGLScene);
glutReshapeFunc(@ReSizeGLScene);
glutKeyboardFunc(@GLKeyboard);

glutMainLoop;
end.


syntax highlighted by Code2HTML, v. 0.9.1
 

среда, 8 июля 2015 г.

Lazarus World. Порт приложения Stars «Звёзды»



Представляю порт приложения Stars «Звёзды», которое было портировано с аналогичного приложения Stars «Звёзды» написаного на языке программирование Delphi и с использованием интерфейса GDI Windows. Оригинальный код приложения, на основе которого сделан порт, взят с сайта Delphi-Graphics. Код портирован на Lazarus с использованием OpenGL для отрисовки графики. Цель портирования - заставить работать приложение в операционной системе Ubuntu Linux. Код порта оставляю без комментарий, т. к. портирование проводилось без детального разбора работы алгоритма оригинального приложения и осуществлялся банальный подбор функций OpenGL и их параметров. На рисунке 1 предсталена работа портированного приложения в Ubuntu Linux. Так же рекомендую поиграться с параметрами OpenGL функций задания цвета звёзд и задания формы звёзд.


Рисунок 1. Приложение «Звезды»

program stars;

uses gl, glut, glu, SysUtils;

var
  Cmd: array of PChar;
  CmdCount: Integer;
  ScreenWidth, ScreenHeight: Integer;

const
  AppWidth = 800;
  AppHeight = 600;
  StarCount = 1000;

Type
  TStar = record
    x,y,z: integer;
    vx, vy, vc: integer;
  end;

var
  Star:array[0..StarCount - 1] of TStar;
  xcenter, ycenter: integer;
  starsize: integer;
  OldTick: GLuint;
  FramesCount: GLuint;
  StartTick: GLuint;


procedure InitStars;
var
s: integer;
begin
     for s:=0 to StarCount - 1 do
     begin
       With Star[s] do
       begin
         vx := -1;
         vy := -1;
         vc := 0;
         x := (Random(2 * xcenter) - xcenter) shl 7;
         y := (Random(2 * ycenter) - ycenter) shl 7;
         z := s + 1;
       end;
     end;
end;

procedure IdleFunc(); cdecl;
begin
     Sleep(1);

     OldTick := GlutGet(GLUT_ELAPSED_TIME);
     glutPostRedisplay;

end;

procedure DrawGLScene; cdecl;
var
   Title: array[0..80] of Char;
   s: integer;
begin
     glClear(GL_COLOR_BUFFER_BIT);

     for s := 0 to StarCount - 1 do
     begin
     with Star[s] do begin

         glColor3f(0.0, 0.0, 0.0);

         glBegin(GL_POINTS);
         glVertex2f(vx, vy);
         glEnd;

         vc := starsize div z;
         vx := x div z + xcenter - vc;
         vy := y div z + ycenter - vc;

         glPointSize(vc);

         glColor3f(1.0, 1.0, 1.0);

         glBegin(GL_POINTS);
         glVertex2f(vx, vy);
         glEnd;

         dec(Star[s].z,3);

         if z<1 then begin
            z:=StarCount;
            x:=(Random(2*xCenter)-xCenter) shl 7;
            y:=(Random(2*yCenter)-yCenter) shl 7;
         end;
     end;

     end;

     glutSwapBuffers;

     FramesCount := FramesCount + 1;
     if (GlutGet(GLUT_ELAPSED_TIME) <> StartTick) then
     begin
          Title := FloatToStrF(FramesCount*1000  
          div (GlutGet(GLUT_ELAPSED_TIME) - StartTick), ffFixed, 8, 0);
          Title := 'FPS: ' + Title;
          glutSetWindowTitle(Title);
     end;
end;

procedure ReSizeGLScene(Width, Height: Integer); cdecl;
begin
  glViewport(0, 0, Width, Height);
end;

procedure GLKeyboard(Key: Byte; X, Y: Longint); cdecl;
begin
  if Key = 27 then
    Halt(0);
end;

procedure InitializeGL;
begin
     glClearColor(0.0, 0.0, 0.0, 0.0);
     gluOrtho2D(0, AppWidth - 1, 0, AppHeight - 1);
end;

procedure InitApp;
begin
     OldTick := GlutGet(GLUT_ELAPSED_TIME);
     StartTick := OldTick;
     FramesCount := 0;

     xcenter := AppWidth div 2;
     ycenter := AppHeight div 2;
     starsize:=xcenter+ycenter;
end;

begin

CmdCount := 1;
SetLength(Cmd, CmdCount);
Cmd[CmdCount-1] := PChar(ParamStr(CmdCount-1));

glutInit(@CmdCount, @Cmd);

glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGB);

glutInitWindowSize(AppWidth, AppHeight);

ScreenWidth := glutGet(GLUT_SCREEN_WIDTH);
ScreenHeight := glutGet(GLUT_SCREEN_HEIGHT);

glutInitWindowPosition((ScreenWidth - AppWidth) div 2,
   (ScreenHeight - AppHeight) div 2);

glutCreateWindow('stars');

InitApp;
InitStars;
InitializeGL;

glutDisplayFunc(@DrawGLScene);
glutIdleFunc(@DrawGLScene);
glutReshapeFunc(@ReSizeGLScene);
glutKeyboardFunc(@GLKeyboard);

glutMainLoop;

end.


syntax highlighted by Code2HTML, v. 0.9.1

вторник, 25 ноября 2014 г.

Медленно сканирует Epson Perfection v10 на Windows 7 Pro 32 bit

Проблема заключается в том, что сканер Epson Perfection v10 по какой-то причине, со временем, перестаёт быстро работать. Тормоза проявляются в том, что программа сканирования может обрабатывать одну страницу по 4-10 минут с периодическим зависанием, то потом отвисанием интерфейса программы и неважно в какой программе вы сканируете документ, в родной программе Epson Scan, VueScan или FineReader. Данная проблема была замечена на Windows 7 Pro 32 bit.

Все действия выполняем под учетной записью администратора.

Чтобы решить проблему необходимо:

1) Скачать последний драйвер на сканер  по ссылке на официальном сайте Epson или по прямой ссылке на ftp - сервере  ftp://download.epson-europe.com/pub/download/3258/epson325829eu.exe. 
Внимание!. На момент написания поста были доступны указанные в ссылках драйвера. Внимательно смотрите на версии драйверов. 
2) Сканер не подключаем к компьютеру, USB - кабель не должен быть подключен к компьютеру.
3) Удаляем драйвера и программное обеспечение на сканер, если такое имеет место быть, из системы через установку/удаление программ в панели управления.
4) Перезагружаем компьютер.
5) Устанавливаем все доступные обновления для вашей операционной системы.
6) Перезагружаем компьютер.
7) Устанавливаем драйвера на сканер.
8) Перезагружаем компьютер.
9) Подключаем сканер к компьютеру, подключаем USB - кабель в USB порт компьютера.
10) Ждем когда система подхватит драйвер сканера.
11) Пробуем сканировать. 

Все идеи взяты с сайта:
http://forum.oszone.net/nextnewesttothread-200146.html

четверг, 30 октября 2014 г.

Вирус шифровальщик-вымогатель .CoDe

Сегодня на работе краем уха слышал как ИТ - администраторы пытались разобраться с вирусом и последствиями его деятельности. Поэтому в данном посте хотелось бы рассказать, что ИТ - администраторам удалось выяснить о вирусе, чтобы пользователи и администраторы имели малейшее представление о нем, и своевременно смогли среагировать.

Внимание! Все названия файлов выдуманы для примера.

Все начилось с того, что в ИТ - отдел пришло обращение, в котором говорилось что в общей сетевой папке на сервере, в которой многие пользователи правят общие файлы Excel и Word, вместо файлов, например file.xlsx и file.docx, появились файлы file.xlsx и file.docx, но с расширением .CoDe, т.е. эти файлы имели имена file.xlsx.CoDe и file.docx.CoDe. При попытке открыть данные файлы в excel или word в файлах отображалось случайный набор символов в непонятной кодировке. Сразу же ИТ - администраторы сошлись в мнение, что это проделки вируса. В Гугле было найдены несколько упоминаний о данном вирусе. Данный вирус на зараженном компьютере зашифровывает файлы excel, word, pdf, изображения и к этим файлам добавляет расширение .CoDe. и на системном диске C: создает папку c названием wiNtmp с файлами вируса. В каждой папке с зашифрованными файлами создается текстовый файл с названием [%username%]_Файлы зашифрованы.txt и с текстом требования денег, где [%username%] - имя пользователя от которого был запущен вирус. Дальше по этому имени пользователя было найдено сетевое имя зараженного компьютера, ну и в последствии сам компьютер с вирусом. Если бы в название файла [%username%]_Файлы зашифрованы.txt не было имени пользователя, то поиск зараженного компьютера было бы затруднительно, т.к. с общей сетевой папкой на сервере работает много пользователей и пришлось бы искать его на всех компьютерах. Что нужно запомнить о данном вирусе:

1. Данный вирус прислан по электронной почте как вложение с письмом, с неизвестного адреса. Так что внимательно относитесь к приходящим письмам и не открывайте вложения с неизвестных адресов.

2. У пользователя были права администратора, таким образом вирус был успешно запущен, по незнанию, на выполнение. Поэтому ни в коем случае не давайте права администратора пользователю.

3. Так как у пользователя были подключены сетевые диски и были разрешения на чтение и запись файлов на сетевом ресурсе, то вирус заразил не только локальные файлы пользователя, но и файлы на сервере.

4. Антивирус Касперского с последними обновлениями баз не смог спасти от провала, так как ничего не обнаружил. Антивирус это не гарант защиты.

5. На поиски зараженного компьютера было потрачено много времени, поэтому был отключен от сети очень поздно. За это время вирус зашифровал большое количество пользовательских файлов и общедоступных сетевых.

6. Так как данные на сервере периодически резервируются, общие пользовательские файлы удалось вытащить из бэкапа. Локальные файлы пользователя зараженного компьютера, думаю, так и останутся зашифрованными. Так что выполняйте бэкапы так часто, на сколько это возможно.  

суббота, 30 ноября 2013 г.

Lazarus World. Используем GLX расширение для связи OpenGL с X Window System


Для создания окна будем использовать библиотеку xlib. Запустите Lazarus и создайте новый проект, для этого выберите пункт меню File>New>Program и нажмите кнопку OK (Смотрите рисунок 1). Назовите его ogl_p3.lpr и сохраните проект в домашней директории пользователя /home/[имя пользователя]/Projects/lazarus/ogl_p3/.

Рисунок 1. Создание нового проекта

Чтобы сохранить проект под выбранным именем, нажмите пункт меню File>Save. В качестве пути сохранения проекта укажите каталог который вы создали ранее.

Если посмотреть в редактор кода среды Lazarus, то можно увидеть уже введенный стартовый код проекта. Удалим лишнее и оставим только то, что нам пригодится в дальнейшем:

program ogl_p3;
uses
begin
end.

Теперь в секции uses подключим необходимые модули:

1) для работы с функциями связывающие opengl с x window system (glx)
2) для работы с функциями создания окна x window system (x, xutil, xlib)
3) для работы с функциями OpenGL (gl, glu)

Таким образом секция uses у нас примит вид:

uses glx, x, xutil, xlib, gl, glu;

Выше секции uses укажите режим синтаксиса совместимый с delphi

{$MODE delphi}

После секции uses создадим секцию глобальных переменных var, в данной секции определим следующие переменные:

var
  dpy: PDisplay;
  visinfo: PXVisualInfo;
  Attr: Array[0..10] of integer =
   (GLX_DEPTH_SIZE, 16,
    GLX_RGBA,
    GLX_RED_SIZE, 1,
    GLX_GREEN_SIZE, 1,
    GLX_BLUE_SIZE, 1,
    GLX_DOUBLEBUFFER,
    none);
  cm: TColormap;
  winAttr: TXSetWindowAttributes;
  win :TWindow;
  glXCont: GLXContext;

1) Указатель на структуру Display с именем dpy, которая определена в xlib и содержит информацию о соединении с X-сервером.
2) Указатель на структуру XvisualInfo c именем visinfo, которая определена в xlib и содержит информацию о визуальных характеристиках поддерживаемых экраном X-сервера.
3) Attr, массив атрибутов визуальных характеристик, которые мы запрашиваем у X-сервера.
4) cm хранит информацию о новой цветовой палитре окна, тип Tcolormap.
5) Структура TXSetWindowAttributes с именем winAttr, хранит все необходимые атрибуты для создания нового окна.
6) Идентификатор, с именем win, созданного окна типа Twindow.
7) Переменная хранящая информацию о созданном контексте рендеринга OpenGL.

Для начала нам нужно определится, что мы будем рисовать с помощью функций OpenGL. В книге Эдварда Эйнджела «Интерактивная компьютерная графика. Вводный курс на базе OpenGL» 2-е издание 2001г. написан си код алгоритма построения треугольника Серпинского. Так что попробуем его нарисовать.

Далее определим новый тип:

type
  point2 = array[1..2] of GLfloat;

Этот новый тип point2, мы будем использовать для описания координат одной точки.

Далее определи секцию var, где определим одну точку (начальная точка, откуда идут все расчеты) и массив из трех точек (вершины большого треугольника):

var
  p: point2 = (0.0, 0.0);
  vertices: array[1..3] of point2 = 
     ((0.0, 0.0), (250.0, 500.0), (500.0, 0.0));

Ниже напишем код процедуры перерисовки окна:

procedure redraw();
var
  j,k: integer;
begin
  Randomize;

  glClear(GL_COLOR_BUFFER_BIT);

  for k:=1 to 250000 do
  begin
    j := Random(3) + 1;

    p[1] := (p[1] + vertices[j][1]) / 2;

    p[2] := (p[2] + vertices[j][2]) / 2;

    glBegin(GL_POINTS);
      glVertex2fv(@p);
    glEnd;
end;

    glXSwapBuffers(dpy, win);
end;

В данной процедуре размещен кусок кода который рисует 250000 точек в определенных координатах согласно алгоритму, эти точки не выходя за пределы большого треугольника.
Здесь процедура glXSwapBuffers переключает сформировавшуюся картинку из буфера кадра на экран.
Ниже напишем процедуру инициализации обзора сцены:


procedure initgl();
begin
  glClearColor(1.0, 1.0, 1.0, 0.0);
  glColor3f(1.0, 0.0, 0.0);

  glMatrixMode(GL_PROJECTION);

  glLoadIdentity();

  gluOrtho2D(0.0, 500.0, 0.0, 500.0);

  glMatrixMode(GL_MODELVIEW);

end;

Ниже напишем процедуру, которая вызывается каждый раз при изменение размеров окна:

procedure resize(width, height: integer);
begin
  glViewport(0, 0, width, height);
end;

Ниже напишем процедуру, в которой находится бесконечный цикл обработки событий окна:

procedure loop();
var
  event: TXEvent;
begin
  while true do
  begin
   XNextEvent(dpy, @event);
   case event._type of
    Expose: redraw();
    ConfigureNotify: resize(event.xconfigure.width,
      event.xconfigure.height);
    KeyPress: halt(1);
   end;
  end;
end;

в данном случае обрабатываются событие перерисовки окна (Expose), событие изменения размеров окна (ConfigureNotify), события нажатия клавиши (KeyPress).

Ниже определим секцию var, в которой определены переменные необходимые для последующего кода проекта в главных операторных скобках (begin ... end.)

var
  errorBase, eventBase: integer;
  title: String;
  window_title_property: TXTextProperty;

1) Переменные с именами errorBase и eventBase нужны для хранения кода ошибок возвращаемые процедурой glXQueryExtension.
2) Переменная строка с именем title для хранения названия заголовка окна
3) Переменная window_title_property необходима для установки имени приложения

Ниже напишем код главных операторных скобок:

begin
  initGlx();

  dpy := XOpenDisplay( nil );

  if (dpy = nil) then
  writeLn('Error: Could not connect to X server');

  if not (glXQueryExtension(dpy, errorBase, eventBase)) then
  writeLn('Error: GLX extension not supported');

  visinfo := glXChooseVisual(dpy, DefaultScreen(dpy), Attr);
  if (visinfo = nil) then
  writeLn('Error: Could not find visual');

  cm := XCreateColormap(dpy, RootWindow(dpy, visinfo.screen),
  visinfo.visual, AllocNone);

  winAttr.colormap := cm;
  winAttr.border_pixel := 0;
  winAttr.background_pixel := 0;
  winAttr.event_mask := ExposureMask or
      ButtonPressMask or
      StructureNotifyMask or
      KeyPressMask;

  win := XCreateWindow(dpy, RootWindow(dpy, visinfo.screen),
  0, 0, 500, 500, 0, visinfo.depth, InputOutput, visinfo.visual,
  CWBorderPixel or CWColormap or CWEventMask, @winAttr);

  title := 'ogl_p3';
  XStringListToTextProperty(@title, 1, @window_title_property);
  XSetWMName(dpy, win, @window_title_property);

  glXCont := glXCreateContext(dpy, visinfo, none, true);
  if (glXCont = nil) then
  writeLn('Error: Could not create an OpenGL rendering context');

  glXMakeCurrent(dpy, win, glXCont);

  XMapWindow(dpy, win);

  initgl();

  loop();

end.


1) Функция initGlx производит инициализацию расширения GLX.
2) Функция XopenDisplay устанавливает соединение клиента с X-сервером.
3) Функция glXQueryExtension запрашивает у X-сервера поддерживает ли он GLX расширения.
4) Функция glXChooseVisual запрашивает у X-сервера возможные визуальные характеристики экрана.
5) Функция XcreateColormap создает новую цветовую палитру для нового окна
6) Далее мы задаем необходимые атрибуты создаваемого окна:

winAttr.colormap := cm;
winAttr.border_pixel := 0;
winAttr.background_pixel := 0;
winAttr.event_mask := ExposureMask or
   ButtonPressMask or
   StructureNotifyMask or
   KeyPressMask;

7) Функция XcreateWindow создает новое окно согласно заданным атрибутам и полученным характеристикам.
8) Следующими строчками кода мы устанавливаем заголовок окна:


 title := 'ogl_p3';
 XStringListToTextProperty(@title, 1, @window_title_property);
 XSetWMName(dpy, win, @window_title_property);

9) Функция glXCreateContext создает контекст OpenGL
10) Функция glXMakeCurrent привязывает созданный контекст OpenGL к созданному окну.
11) Функция XmapWindow делает окно видимым
12) Перед тем как передать управление обработчику событий окна, необходимо выполнить процедуру initgl инициализации обзора сцены.
13) Запускаем бесконечный цикл обработки событий окна.

Теперь давайте соберем проект. Результат работы программы представлен рисунком 2.
  
Рисунок 2. Треугольник Серпинского

Код полностью:
program ogl_p3;

{$MODE delphi}

uses glx, x, xutil, xlib, gl, glu;

var
  dpy: PDisplay;
  visinfo: PXVisualInfo;
  Attr: Array[0..10] of integer =
    (GLX_DEPTH_SIZE, 16,
     GLX_RGBA,
     GLX_RED_SIZE, 1,
     GLX_GREEN_SIZE, 1,
     GLX_BLUE_SIZE, 1,
     GLX_DOUBLEBUFFER,
     none);
  cm: TColormap;
  winAttr: TXSetWindowAttributes;
  win :TWindow;
  glXCont: GLXContext;

type
   point2 = array[1..2] of GLfloat;
var
   p: point2 = (0.0, 0.0);
   vertices: array[1..3] of point2 =  
           ((0.0, 0.0), (250.0, 500.0), (500.0, 0.0));

procedure redraw();
var
   j,k: integer;
begin
  Randomize;

  glClear(GL_COLOR_BUFFER_BIT);

  for k:=1 to 250000 do
  begin
       j := Random(3) + 1;

       p[1] := (p[1] + vertices[j][1]) / 2;

       p[2] := (p[2] + vertices[j][2]) / 2;

       glBegin(GL_POINTS);
        glVertex2fv(@p);
       glEnd;
  end;

  glXSwapBuffers(dpy, win);
end;

procedure initgl();
begin
  glClearColor(1.0, 1.0, 1.0, 0.0);
  glColor3f(1.0, 0.0, 0.0);

  glMatrixMode(GL_PROJECTION);

  glLoadIdentity();

  gluOrtho2D(0.0, 500.0, 0.0, 500.0);

  glMatrixMode(GL_MODELVIEW);

end;

procedure resize(width, height: integer);
begin
  glViewport(0, 0, width, height);
end;

procedure loop();
var
  event: TXEvent;
begin
  while true do
  begin
    XNextEvent(dpy, @event);
    case event._type of
         Expose: redraw();
         ConfigureNotify: resize(event.xconfigure.width,
                          event.xconfigure.height);
         KeyPress: halt(1);
    end;
  end;
end;

var
  errorBase, eventBase: integer;
  title: String;
  window_title_property: TXTextProperty;
begin
  initGlx();

  dpy := XOpenDisplay( nil );

  if (dpy = nil) then
  writeLn('Error: Could not connect to X server');

  if not (glXQueryExtension(dpy, errorBase, eventBase)) then
  writeLn('Error: GLX extension not supported');

  visinfo := glXChooseVisual(dpy, DefaultScreen(dpy), Attr);
  if (visinfo = nil) then
  writeLn('Error: Could not find visual');

  cm := XCreateColormap(dpy, RootWindow(dpy, visinfo.screen),
  visinfo.visual, AllocNone);

     winAttr.colormap := cm;
     winAttr.border_pixel := 0;
     winAttr.background_pixel := 0;
     winAttr.event_mask := ExposureMask or
                           ButtonPressMask or
                           StructureNotifyMask or
                           KeyPressMask;

  win := XCreateWindow(dpy, RootWindow(dpy, visinfo.screen),
  0, 0, 500, 500, 0, visinfo.depth, InputOutput, visinfo.visual,
  CWBorderPixel or CWColormap or CWEventMask, @winAttr);

  title := 'ogl_p3';
  XStringListToTextProperty(@title, 1, @window_title_property);
  XSetWMName(dpy, win, @window_title_property);

  glXCont := glXCreateContext(dpy, visinfo, none, true);
  if (glXCont = nil) then
  writeLn('Error: Could not create an OpenGL rendering context');

  glXMakeCurrent(dpy, win, glXCont);

  XMapWindow(dpy, win);

  initgl();

  loop();

end.


syntax highlighted by Code2HTML, v. 0.9.1