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