Порт графической сцены “Огонь” с Game Maker Studio на Lazarus 4.6 + SDL 2 + dglOpenGL + Debian 13

Пример кода порта графической сцены “Огонь” с Game Maker Studio на Lazarus 4.6 + SDL 2 + dglOpenGL + Debian 13. Медиа ресурсы, которые использованы в графической сцене и сам исходный код на Game Maker Studio можно скачать с сайта https://martincrownover.com/gamemaker-examples-tutorials/particles-fire/ или по прямой ссылке http://martincrownover.com/files/examples/gm-example-particles-fire.zip.

Рисунок 1. Графическая сцена "Огонь"

Код файла ogl_p6.lpr:

program ogl_p6;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, SysUtils, sdl2, sdl2_image, dglOpenGL, uFireParticleSystem // Модуль, который мы создали ранее
  { you can add units after this };

const
  SCREEN_WIDTH  = 800;
  SCREEN_HEIGHT = 450;
  FPS_TARGET    = 60;
  FRAME_DELAY   = 1000 div FPS_TARGET;

var
  Window: PSDL_Window = nil;
  GLContext: TSDL_GLContext = nil;
  Event: TSDL_Event;
  Running: Boolean = True;

  // Массивы для хранения ID текстур каждого кадра
  TexFireArray: array[0..7] of GLuint;
  TexCinderArray: array[0..2] of GLuint;
  FireSystem: TFireSystem;

  FrameStart: UInt32;
  FrameTime: UInt32;

  // Счётчик для циклов загрузки и удаления текстур
  i: Integer;

// Функция загрузки остаётся прежней, она просто грузит один файл и возвращает его ID
function LoadTexture(const Path: string): GLuint;
var
  Surface: PSDL_Surface;
  TextureID: GLuint;
  Mode: GLenum;
begin
  Result := 0;
  Surface := IMG_Load(PChar(Path));
  if Surface = nil then begin
    WriteLn('Ошибка загрузки: ', Path, ' -> ', IMG_GetError());
    Exit;
  end;
  if Surface^.format^.BytesPerPixel = 4 then Mode := GL_RGBA else Mode := GL_RGB;
  glGenTextures(1, @TextureID);
  glBindTexture(GL_TEXTURE_2D, TextureID);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexImage2D(GL_TEXTURE_2D, 0, Mode, Surface^.w, Surface^.h, 0, Mode, GL_UNSIGNED_BYTE, Surface^.pixels);
  SDL_FreeSurface(Surface);
  Result := TextureID;
end;

procedure InitGL;
begin
  if not InitOpenGL then
  begin
    WriteLn('Критическая ошибка: dglOpenGL не смог инициализироваться!');
    Halt(1);
  end;
  ReadExtensions;

  // Настройка 2D ортографической проекции под размеры комнаты GameMaker
  glViewport(0, 0, SCREEN_WIDTH, SCREEN_HEIGHT);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  // Лево=0, Право=800, Низ=450, Верх=0 (Инвертируем Y, как в GameMaker)
  glOrtho(0, SCREEN_WIDTH, SCREEN_HEIGHT, 0, -1, 1);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();

  // Базовые параметры рендеринга
  glClearColor(0.0, 0.0, 0.0, 1.0); // Черный фон из rm_test.room.gmx
  glDisable(GL_DEPTH_TEST);         // 2D режим, глубина не нужна
end;

begin
  // Инициализация SDL2
  if SDL_Init(SDL_INIT_VIDEO) < 0 then
  begin
    WriteLn('Ошибка SDL_Init: ', SDL_GetError());
    Halt(1);
  end;

  if IMG_Init(IMG_INIT_PNG) = 0 then
  begin
    WriteLn('Ошибка IMG_Init: ', IMG_GetError());
    SDL_Quit();
    Halt(1);
  end;

  // Настройка атрибутов OpenGL контекста
  SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
  SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
  SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);

  // Создание окна
  Window := SDL_CreateWindow(
    'GameMaker Fire Example Port (Lazarus + SDL2 + OpenGL)',
    SDL_WINDOWPOS_CENTERED, SDL_WINDOWPOS_CENTERED,
    SCREEN_WIDTH, SCREEN_HEIGHT,
    SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN
  );

  if Window = nil then
  begin
    WriteLn('Не удалось создать окно: ', SDL_GetError());
    SDL_Quit();
    Halt(1);
  end;

  GLContext := SDL_GL_CreateContext(Window);
  if GLContext = nil then
  begin
    WriteLn('Не удалось создать OpenGL контекст: ', SDL_GetError());
    SDL_DestroyWindow(Window);
    SDL_Quit();
    Halt(1);
  end;

  InitGL;

   // Загрузка кадров огня (0..7)
  for i := 0 to 7 do
    TexFireArray[i] := LoadTexture('images/spr_fire_' + IntToStr(i) + '.png');

  // Загрузка кадров искр (0..2)
  for i := 0 to 2 do
    TexCinderArray[i] := LoadTexture('images/spr_cinder_' + IntToStr(i) + '.png');

  // Инициализация системы частиц
  FireSystem := TFireSystem.Create;
  // Передаем массивы в класс (метод обновим ниже)
  FireSystem.SetTextures(TexFireArray, TexCinderArray);

  // Главный игровой цикл (60 FPS Game Loop)
  while Running do
  begin
    FrameStart := SDL_GetTicks();

    // Обработка ввода и системных событий Linux
    while SDL_PollEvent(@Event) <> 0 do
    begin
      if Event.type_ = SDL_QUITEV then
        Running := False;
      if (Event.type_ = SDL_KEYDOWN) and (Event.key.keysym.sym = SDLK_ESCAPE) then
        Running := False;
    end;

    // Логика (Аналог Step в GameMaker)
    FireSystem.Step;

    // Рендеринг (Аналог Draw в GameMaker)
    glClear(GL_COLOR_BUFFER_BIT);
    glLoadIdentity();

    FireSystem.Draw;

    SDL_GL_SwapWindow(Window);

    // Ограничение кадров до 60 FPS
    FrameTime := SDL_GetTicks() - FrameStart;
    if FrameTime < FRAME_DELAY then
      SDL_Delay(FRAME_DELAY - FrameTime);
  end;

  // Очистка памяти
  FireSystem.Free;

  for i := 0 to 7 do glDeleteTextures(1, @TexFireArray[i]);
  for i := 0 to 2 do glDeleteTextures(1, @TexCinderArray[i]);


  SDL_GL_DeleteContext(GLContext);
  SDL_DestroyWindow(Window);
  IMG_Quit();
  SDL_Quit();
end.

 

Код файла ufireparticlesystem.pas: 

unit uFireParticleSystem;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, dglOpenGL, Math;

type
  TParticle = record
    X, Y: Single;
    Speed: Single;
    SpdIncr: Single;
    Angle: Single;
    RotAngle: Single;
    RotSpeed: Single;
    Size: Single;
    SizeIncr: Single;
    Life: Single;
    MaxLife: Single;
    IsCinder: Boolean;
    ColorR, ColorG, ColorB: Single;
    Frame: Integer;       // Текущий кадр анимации
    FrameTimer: Single;   // Таймер для смены кадров
  end;

TFireSystem = class
private
  Particles: array of TParticle;
  ParticleCount: Integer;
  // Меняем на массивы фиксированной длины
  TexFire: array[0..7] of GLuint;
  TexCinder: array[0..2] of GLuint;
  procedure EmitParticle(IsCinder: Boolean);
public
  constructor Create;
  destructor Destroy; override;
  // Новый интерфейс для принятия массивов
  procedure SetTextures(const AFireTex: array of GLuint; const ACinderTex: array of GLuint);
  procedure Step;
  procedure Draw;
end;


implementation

constructor TFireSystem.Create;
begin
  inherited Create;
  SetLength(Particles, 4000); // Запас под интенсивный поток частиц
  ParticleCount := 0;
  Randomize;
end;

destructor TFireSystem.Destroy;
begin
  SetLength(Particles, 0);
  inherited Destroy;
end;

procedure TFireSystem.SetTextures(const AFireTex: array of GLuint; const ACinderTex: array of GLuint);
var
  i: Integer;
begin
  for i := 0 to 7 do TexFire[i] := AFireTex[i];
  for i := 0 to 2 do TexCinder[i] := ACinderTex[i];
end;

procedure TFireSystem.EmitParticle(IsCinder: Boolean);
var
  p: TParticle;
begin
  if ParticleCount >= Length(Particles) then Exit;

  p.IsCinder := IsCinder;

  // Координаты эмиттера из obj_fire.object.gmx
  p.X := -50.0 + Random * 900.0; // от -50 до 850
  p.Y := 450.0 + Random * 50.0;  // от 450 до 500
  p.RotAngle := Random * 360.0;

  if not IsCinder then
  begin
    // Настройки из init_particles.gml для global.part_fire
    p.MaxLife := 25 + Random(11);      // part_type_life(..., 25, 35)
    p.Size := 1.5 + Random * 1.5;      // part_type_size(..., 1.5, 3, ...)
    p.SizeIncr := -0.05;               // уменьшение размера за кадр
    p.RotSpeed := 2.0;                 // part_type_orientation(..., 2, ...)
    p.Angle := 85.0 + Random * 10.0;   // part_type_direction(..., 85, 95, ...)
    p.Speed := 2.0 + Random * 8.0;     // part_type_speed(..., 2, 10, ...)
    p.SpdIncr := -0.1;                 // замедление скорости за кадр
    p.Frame := Random(8);              // Случайный стартовый кадр (всего 8)
  end else
  begin
    // Настройки из init_particles.gml для global.part_cinder
    p.MaxLife := 45 + Random(31);      // part_type_life(..., 45, 75)
    p.Size := 0.5 + Random * 0.25;     // part_type_size(..., 0.5, 0.75, ...)
    p.SizeIncr := -0.001;
    p.RotSpeed := 0.05;
    p.Angle := 85.0 + Random * 40.0;   // part_type_direction(..., 85, 125, ...)
    p.Speed := 6.0 + Random * 2.0;     // part_type_speed(..., 6, 8, ...)
    p.SpdIncr := 0.0;
    p.Frame := Random(3);              // Случайный стартовый кадр (всего 3)
  end;

  p.FrameTimer := 0.0;
  p.Life := p.MaxLife;
  Particles[ParticleCount] := p;
  Inc(ParticleCount);
end;

procedure TFireSystem.Step;
var
  i: Integer;
  Rad, LifePercent: Single;
begin
  // Интенсивность из obj_fire (10 огней, 1/5 шанс искры (заменили стабильными 2))
  for i := 1 to 10 do EmitParticle(False);
  for i := 1 to 2 do EmitParticle(True);

  i := 0;
  while i < ParticleCount do
  begin
    // Физика движения
    Particles[i].Speed := Max(0, Particles[i].Speed + Particles[i].SpdIncr);
    Particles[i].Size := Max(0, Particles[i].Size + Particles[i].SizeIncr);
    Particles[i].RotAngle := Particles[i].RotAngle + Particles[i].RotSpeed;

    Rad := DegToRad(Particles[i].Angle);
    Particles[i].X := Particles[i].X + Cos(Rad) * Particles[i].Speed;
    Particles[i].Y := Particles[i].Y - Sin(Rad) * Particles[i].Speed; // Минус, так как Y в 2D идет вниз

    Particles[i].Life := Particles[i].Life - 1.0;

    if (Particles[i].Life <= 0) or (Particles[i].Size <= 0) then
    begin
      Particles[i] := Particles[ParticleCount - 1];
      Dec(ParticleCount);
    end else
    begin
      LifePercent := Particles[i].Life / Particles[i].MaxLife;

      // part_type_color2: плавное смешивание Orange (1.0, 0.65, 0.0) -> Red (1.0, 0.0, 0.0)
      Particles[i].ColorR := 1.0;
      Particles[i].ColorG := 0.65 * LifePercent;
      Particles[i].ColorB := 0.0;

      // Обновление кадров анимации (эмуляция GameMaker анимации)
      Particles[i].FrameTimer := Particles[i].FrameTimer + 0.15; // Скорость анимации
      if Particles[i].FrameTimer >= 1.0 then
      begin
        Particles[i].FrameTimer := 0.0;
        if not Particles[i].IsCinder then
          Particles[i].Frame := (Particles[i].Frame + 1) mod 8
        else
          Particles[i].Frame := (Particles[i].Frame + 1) mod 3;
      end;

      Inc(i);
    end;
  end;
end;

procedure TFireSystem.Draw;
var
  i: Integer;
  HalfSize, Alpha, LifePercent: Single;
begin
  glEnable(GL_TEXTURE_2D);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE);

  for i := 0 to ParticleCount - 1 do
  begin
    // Выбираем текстуру конкретного кадра, который сейчас просчитан у частицы
    if Particles[i].IsCinder then
      glBindTexture(GL_TEXTURE_2D, TexCinder[Particles[i].Frame])
    else
      glBindTexture(GL_TEXTURE_2D, TexFire[Particles[i].Frame]);

    // Размер по XML 64x64
    HalfSize := (64.0 * Particles[i].Size) / 2.0;

    LifePercent := Particles[i].Life / Particles[i].MaxLife;
    if LifePercent > 0.5 then Alpha := 1.0 else Alpha := LifePercent * 2.0;

    glColor4f(Particles[i].ColorR, Particles[i].ColorG, Particles[i].ColorB, Alpha);

    glPushMatrix;
    glTranslatef(Particles[i].X, Particles[i].Y, 0);
    glRotatef(Particles[i].RotAngle, 0, 0, 1);

    // Координаты текстуры всегда полные (0..1), так как картинки отдельные
    glBegin(GL_QUADS);
      glTexCoord2f(0, 0); glVertex2f(-HalfSize, -HalfSize);
      glTexCoord2f(1, 0); glVertex2f(HalfSize, -HalfSize);
      glTexCoord2f(1, 1); glVertex2f(HalfSize, HalfSize);
      glTexCoord2f(0, 1); glVertex2f(-HalfSize, HalfSize);
    glEnd;

    glPopMatrix;
  end;

  glDisable(GL_BLEND);
  glDisable(GL_TEXTURE_2D);
end;

end.