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

 

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