Графическая сцена “Огонь” на Lazarus 4.6 + SDL 2 + dglOpenGL + Debian 13

Пример кода графической сцены “Огонь” на Lazarus 4.6 + SDL 2 + dglOpenGL + Debian 13. За основу графической сцены “Огонь” взят описаный алгоритм из статьи на сайте https://fabiensanglard.net/doom_fire_psx/. 

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

 

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

program ogl_p7;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, SysUtils, sdl2, sdl2_image, sdl2_ttf, dglOpenGL, SparksSystem
  { you can add units after this };

const
  FIRE_WIDTH  = 320; // Низкое разрешение для аутентичного просчета физики
  FIRE_HEIGHT = 240;
  FIRE_SIZE   = FIRE_WIDTH * FIRE_HEIGHT;

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

type
  TColorRGB = record
    R, G, B: Byte;
  end;

  TFirePalette = array[0..36] of TColorRGB;
  TFireBuffer  = array[0..FIRE_SIZE - 1] of Byte;
  TScreenRGB   = array[0..FIRE_SIZE - 1] of TColorRGB;

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

  FrameStart, FrameTime: UInt32;

  FireBuffer: TFireBuffer;    // Буфер индексов [0..36]
  ScreenRGB: TScreenRGB;      // Буфер для вывода в OpenGL текстуру
  TextureID: GLuint;          // ID текстуры OpenGL

  // Переменные для работы со шрифтами
  Font: PTTF_Font = nil;
  CurrentPalette: TFirePalette;
  WindShift: Integer = 1; // 1 - штиль (строго вверх), 0 - ветер вправо, 2 - ветер влево

  // Текущая отображаемая палитра, которая будет плавно меняться
  ActiveDisplayPalette: TFirePalette;
  // Целевая палитра, к которой мы осуществляем переход
  TargetPalette: TFirePalette;

  // Переменная для контроля скорости анимации (не зависит от FPS)
  LastFrameTime: UInt32 = 0;

const
  // 1. КЛАССИЧЕСКАЯ ПАЛИТРА (Огонь)
  PaletteClassic: TFirePalette = (
    (R:   7; G:   7; B:   7), (R:  31; G:   7; B:   7), (R:  55; G:   7; B:   7),
    (R:  79; G:  15; B:   7), (R: 103; G:  15; B:   7), (R: 127; G:  23; B:   7),
    (R: 151; G:  23; B:   7), (R: 175; G:  31; B:   7), (R: 199; G:  39; B:  15),
    (R: 223; G:  47; B:  15), (R: 223; G:  55; B:  15), (R: 223; G:  63; B:  15),
    (R: 215; G:  71; B:  15), (R: 215; G:  79; B:  15), (R: 215; G:  87; B:  15),
    (R: 207; G:  95; B:  23), (R: 207; G: 103; B:  23), (R: 207; G: 111; B:  23),
    (R: 199; G: 119; B:  23), (R: 199; G: 127; B:  23), (R: 191; G: 135; B:  31),
    (R: 191; G: 143; B:  31), (R: 191; G: 151; B:  31), (R: 183; G: 159; B:  31),
    (R: 183; G: 167; B:  39), (R: 183; G: 175; B:  39), (R: 175; G: 183; B:  39),
    (R: 175; G: 191; B:  39), (R: 175; G: 199; B:  47), (R: 167; G: 207; B:  47),
    (R: 167; G: 215; B:  47), (R: 167; G: 223; B:  47), (R: 159; G: 231; B:  47),
    (R: 159; G: 239; B:  55), (R: 159; G: 247; B:  55), (R: 151; G: 255; B:  55),
    (R: 255; G: 255; B: 255)
  );

  // 2. СИНЯЯ ПАЛИТРА (Ледяное пламя)
  PaletteBlue: TFirePalette = (
    (R:   0; G:   0; B:  10), (R:   0; G:   5; B:  30), (R:   0; G:  10; B:  50),
    (R:   0; G:  15; B:  70), (R:   0; G:  20; B:  90), (R:   0; G:  25; B: 110),
    (R:   0; G:  30; B: 130), (R:   0; G:  40; B: 150), (R:   0; G:  50; B: 170),
    (R:   0; G:  60; B: 190), (R:   0; G:  70; B: 200), (R:   0; G:  80; B: 210),
    (R:   0; G:  90; B: 220), (R:   0; G: 100; B: 230), (R:   0; G: 110; B: 240),
    (R:   0; G: 120; B: 250), (R:   0; G: 130; B: 255), (R:  10; G: 140; B: 255),
    (R:  20; G: 150; B: 255), (R:  30; G: 160; B: 255), (R:  40; G: 170; B: 255),
    (R:  50; G: 180; B: 255), (R:  60; G: 190; B: 255), (R:  70; G: 200; B: 255),
    (R:  80; G: 210; B: 255), (R:  90; G: 220; B: 255), (R: 100; G: 230; B: 255),
    (R: 120; G: 240; B: 255), (R: 140; G: 245; B: 255), (R: 160; G: 250; B: 255),
    (R: 180; G: 252; B: 255), (R: 200; G: 255; B: 255), (R: 210; G: 255; B: 255),
    (R: 220; G: 255; B: 255), (R: 230; G: 255; B: 255), (R: 240; G: 255; B: 255),
    (R: 255; G: 255; B: 255)
  );

  // 3. ЗЕЛЕНАЯ ПАЛИТРА (Некромантия / Кислота)
  PaletteGreen: TFirePalette = (
    (R:   0; G:  10; B:   0), (R:   0; G:  30; B:   0), (R:   0; G:  50; B:   0),
    (R:   0; G:  70; B:   0), (R:   0; G:  90; B:   0), (R:   0; G: 110; B:   0),
    (R:   0; G: 130; B:   0), (R:   0; G: 150; B:   0), (R:  10; G: 160; B:   5),
    (R:  20; G: 170; B:  10), (R:  30; G: 180; B:  15), (R:  40; G: 190; B:  20),
    (R:  50; G: 200; B:  25), (R:  60; G: 210; B:  30), (R:  70; G: 220; B:  35),
    (R:  80; G: 230; B:  40), (R:  90; G: 240; B:  45), (R: 100; G: 245; B:  50),
    (R: 110; G: 250; B:  60), (R: 120; G: 255; B:  70), (R: 130; G: 255; B:  80),
    (R: 140; G: 255; B:  90), (R: 150; G: 255; B: 100), (R: 160; G: 255; B: 110),
    (R: 170; G: 255; B: 120), (R: 180; G: 255; B: 135), (R: 190; G: 255; B: 150),
    (R: 200; G: 255; B: 165), (R: 210; G: 255; B: 180), (R: 220; G: 255; B: 195),
    (R: 225; G: 255; B: 210), (R: 230; G: 255; B: 220), (R: 235; G: 255; B: 230),
    (R: 240; G: 255; B: 240), (R: 245; G: 255; B: 245), (R: 250; G: 255; B: 250),
    (R: 255; G: 255; B: 255)
  );

  // 4. ФИОЛЕТОВАЯ ПАЛИТРА (Мистическая магия искажения)
  PalettePurple: TFirePalette = (
    (R:  10; G:   0; B:  10), (R:  25; G:   0; B:  30), (R:  40; G:   0; B:  50),
    (R:  55; G:   0; B:  70), (R:  70; G:   0; B:  90), (R:  85; G:   0; B: 110),
    (R: 100; G:   0; B: 130), (R: 115; G:   0; B: 150), (R: 130; G:  10; B: 165),
    (R: 145; G:  15; B: 180), (R: 160; G:  20; B: 195), (R: 175; G:  25; B: 210),
    (R: 190; G:  30; B: 225), (R: 205; G:  35; B: 240), (R: 215; G:  40; B: 250),
    (R: 220; G:  45; B: 255), (R: 225; G:  55; B: 255), (R: 230; G:  70; B: 255),
    (R: 235; G:  85; B: 255), (R: 235; G: 100; B: 255), (R: 240; G: 115; B: 255),
    (R: 240; G: 130; B: 255), (R: 242; G: 145; B: 255), (R: 242; G: 160; B: 255),
    (R: 245; G: 175; B: 255), (R: 245; G: 190; B: 255), (R: 248; G: 200; B: 255),
    (R: 248; G: 210; B: 255), (R: 250; G: 220; B: 255), (R: 250; G: 230; B: 255),
    (R: 252; G: 235; B: 255), (R: 252; G: 240; B: 255), (R: 253; G: 245; B: 255),
    (R: 253; G: 250; B: 255), (R: 254; G: 252; B: 255), (R: 254; G: 254; B: 255),
    (R: 255; G: 255; B: 255)
  );

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 режим, глубина не нужна

  // Включаем прозрачность для красивого наложения букв текста
  // Включаем смешивание цветов (альфа-канал) для прозрачного фона текста
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
end;

procedure SpreadFire(SrcIndex: Integer); inline;
var
  Rand, TargetIndex, Decay: Integer;
begin
  Rand := Random(4);

  // ВМЕСТО "+ 1" подставляем переменную WindShift
  TargetIndex := SrcIndex - FIRE_WIDTH - Rand + WindShift;

  if (TargetIndex < 0) or (TargetIndex >= FIRE_SIZE) then Exit;

  Decay := Rand and 1;

  if FireBuffer[SrcIndex] >= Decay then
    FireBuffer[TargetIndex] := FireBuffer[SrcIndex] - Decay
  else
    FireBuffer[TargetIndex] := 0;
end;

procedure AnimatePalette;
var
  I: Integer;
  CurrentTime, DeltaTime: UInt32;
  Factor: Single;
  DiffR, DiffG, DiffB: Single;
begin
  CurrentTime := SDL_GetTicks();
  if LastFrameTime = 0 then LastFrameTime := CurrentTime;

  // Получаем время, прошедшее с прошлого кадра в секундах
  DeltaTime := CurrentTime - LastFrameTime;
  LastFrameTime := CurrentTime;

  // Factor определяет скорость перехода.
  // 1.0 = переход за 1 секунду. 0.5 = переход за 2 секунды.
  Factor := (DeltaTime / 1000.0) * 1.0;
  if Factor > 1.0 then Factor := 1.0;
  if Factor <= 0.0 then Exit;

  // Проходим по всем 37 цветам палитры
  for I := 0 to 36 do
  begin
    // Вычисляем разницу между текущим и целевым цветом
    DiffR := TargetPalette[I].R - ActiveDisplayPalette[I].R;
    DiffG := TargetPalette[I].G - ActiveDisplayPalette[I].G;
    DiffB := TargetPalette[I].B - ActiveDisplayPalette[I].B;

    // Плавно приближаем текущий цвет к целевому
    ActiveDisplayPalette[I].R := Round(ActiveDisplayPalette[I].R + (DiffR * Factor));
    ActiveDisplayPalette[I].G := Round(ActiveDisplayPalette[I].G + (DiffG * Factor));
    ActiveDisplayPalette[I].B := Round(ActiveDisplayPalette[I].B + (DiffB * Factor));
  end;
end;

procedure Fire_Init;
var
  i, StartOfLastLine: Integer;
begin
  Randomize;
  // Изначально отображаемая и целевая палитры одинаковы
  ActiveDisplayPalette := PaletteClassic;
  TargetPalette := PaletteClassic;
  CurrentPalette := PaletteClassic; // Если эта переменная еще используется, оставляем

  // Очищаем буфер (Часть 2 — все черное)
  FillChar(FireBuffer, SizeOf(FireBuffer), 0);
  FillChar(ScreenRGB, SizeOf(ScreenRGB), 0);

  // Заполняем нижнюю строчку источником огня (Часть 2 — значение 36)
  StartOfLastLine := (FIRE_HEIGHT - 1) * FIRE_WIDTH;
  for i := StartOfLastLine to FIRE_SIZE - 1 do
    FireBuffer[i] := 36;

  // Создаем динамическую текстуру в OpenGL
  glGenTextures(1, @TextureID);
  glBindTexture(GL_TEXTURE_2D, TextureID);

  // Включаем GL_LINEAR для современного "гладкого" вида пламени
  // Если захотите ретро-пиксели, смените GL_LINEAR на GL_NEAREST
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

  // Выделяем память под текстуру в видеокарте
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, FIRE_WIDTH, FIRE_HEIGHT, 0, GL_RGB, GL_UNSIGNED_BYTE, nil);
end;

procedure Fire_Update;
var
  x, y, Index: Integer;
begin
  // Просчет физики огня снизу вверх (Часть 3)
  // Начинаем с y = 1 (строка 0 сверху не обновляется, как и самая нижняя)
  for x := 0 to FIRE_WIDTH - 1 do
  begin
    for y := 1 to FIRE_HEIGHT - 1 do
    begin
      SpreadFire(y * FIRE_WIDTH + x);
    end;
  end;

  // Переводим индексы [0..36] в реальные RGB цвета из палитры
  for Index := 0 to FIRE_SIZE - 1 do
  begin
    ScreenRGB[Index] := ActiveDisplayPalette[FireBuffer[Index]];
  end;

  // Обновляем текстуру на видеокарте новыми данными
  glBindTexture(GL_TEXTURE_2D, TextureID);
  glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, FIRE_WIDTH, FIRE_HEIGHT, GL_RGB, GL_UNSIGNED_BYTE, @ScreenRGB[0]);
end;

procedure Fire_Render;
begin
  // Очищаем экран (черный фон)
  glClearColor(0.0, 0.0, 0.0, 1.0);
  glClear(GL_COLOR_BUFFER_BIT);

  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, TextureID);

  // Рисуем прямоугольник в пиксельных координатах glOrtho (0..800, 0..450)
  glBegin(GL_QUADS);
    glTexCoord2f(0.0, 0.0); glVertex2f(0, 0);                           // Верх-лево
    glTexCoord2f(1.0, 0.0); glVertex2f(SCREEN_WIDTH, 0);                // Верх-право
    glTexCoord2f(1.0, 1.0); glVertex2f(SCREEN_WIDTH, SCREEN_HEIGHT);   // Низ-право
    glTexCoord2f(0.0, 1.0); glVertex2f(0, SCREEN_HEIGHT);               // Низ-лево
  glEnd;

  glDisable(GL_TEXTURE_2D);
end;

// ИНТЕГРАЦИЯ ВАШЕЙ СИСТЕМЫ ПЕЧАТИ (Части 2, 3, 4, 5 вашего примера)
procedure DrawHints;
var
  W, H: Integer;
  Lines: array of string;
  I: Integer;
  Surface: PSDL_Surface;
  TexID: GLuint;
  Color: TSDL_Color;
  XPos, YPos: Integer;
  BgHeight: Integer;
  MaxWidth: Integer;
  LineHeights: array of Integer;
  TotalHeight: Integer;
  ConvSurface: PSDL_Surface;
  StringW, StringH: Integer;
begin
  if Font = nil then Exit;

  SDL_GetWindowSize(Window, @W, @H);

  // Наш русский текст подсказок выбора магии
  Lines := [
    'Выбор магии стихий: [1] Огонь  [2] Лед  [3] Кислота  [4] Бездна',
    'Управление ветром:  [<->] Вправо  [^] Штиль',
    'ESC - Выход из демо-сцены'
  ];


  // Полностью безопасный расчет размеров без вызова Render функций
  SetLength(LineHeights, Length(Lines));
  MaxWidth := 0;
  TotalHeight := 0;

  for I := 0 to High(Lines) do
  begin

    StringW := 0;
    StringH := 0;

    // Быстро узнаем ширину и высоту строки без создания SDL_Surface
    if TTF_SizeUTF8(Font, PChar(Lines[I]), @StringW, @StringH) = 0 then
    begin
      LineHeights[I] := StringH;
      if StringW > MaxWidth then
        MaxWidth := StringW;

      TotalHeight := TotalHeight + StringH + 5;
    end
    else
    begin
      LineHeights[I] := 0;
    end;
  end;


  // --- Сохраняем состояние OpenGL ---
  glPushAttrib(GL_ENABLE_BIT or GL_TEXTURE_BIT or GL_CURRENT_BIT);
  glMatrixMode(GL_PROJECTION);
  glPushMatrix;
  glLoadIdentity;
  glOrtho(0, W, H, 0, -1, 1);
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;

  glDisable(GL_DEPTH_TEST);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

  XPos := 10;
  YPos := 10;

  // --- Полупрозрачная чёрная подложка ---
  BgHeight := TotalHeight + 10;
  glDisable(GL_TEXTURE_2D);
  glColor4f(0.0, 0.0, 0.0, 0.6);
  glBegin(GL_QUADS);
    glVertex2f(XPos, YPos);
    glVertex2f(XPos + MaxWidth + 20, YPos);
    glVertex2f(XPos + MaxWidth + 20, YPos + BgHeight);
    glVertex2f(XPos, YPos + BgHeight);
  glEnd;

  // --- Рендерим каждую строку текста ---
  YPos := YPos + 8;
    // === ИСПРАВЛЕНИЕ: Обязательно задаем белый цвет для шрифта! ===
  Color.r := 255; Color.g := 255; Color.b := 255; Color.a := 255;

  for I := 0 to High(Lines) do
  begin
    Surface := TTF_RenderUTF8_Blended(Font, PChar(Lines[I]), Color);
    if Surface <> nil then
    begin
      ConvSurface := SDL_ConvertSurfaceFormat(Surface, SDL_PIXELFORMAT_ABGR8888, 0);
      if ConvSurface <> nil then
      begin
       glGenTextures(1, @TexID);
       glBindTexture(GL_TEXTURE_2D, TexID);

       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

       glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
       glPixelStorei(GL_UNPACK_ROW_LENGTH, ConvSurface^.pitch div 4);

       // Загружаем текстуру текста
       glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, ConvSurface^.w, ConvSurface^.h, 0, GL_RGBA, GL_UNSIGNED_BYTE, ConvSurface^.pixels);

       // === ИСПРАВЛЕНИЕ: МГНОВЕННЫЙ СБРОС ПАРАМЕТРОВ РАСПАКОВКИ ===
       glPixelStorei(GL_UNPACK_ROW_LENGTH, 0); // Сбрасываем длину строки в авто-режим
       glPixelStorei(GL_UNPACK_ALIGNMENT, 4);  // Возвращаем стандартное выравнивание 4 байта
       // ==========================================================

       glEnable(GL_TEXTURE_2D);
       glColor4f(1.0, 1.0, 1.0, 1.0);

       glBegin(GL_QUADS);
         glTexCoord2f(0.0, 0.0); glVertex2f(XPos + 10, YPos);
         glTexCoord2f(1.0, 0.0); glVertex2f(XPos + 10 + Surface^.w, YPos);
         glTexCoord2f(1.0, 1.0); glVertex2f(XPos + 10 + Surface^.w, YPos + Surface^.h);
         glTexCoord2f(0.0, 1.0); glVertex2f(XPos + 10, YPos + Surface^.h);
       glEnd;

       glDeleteTextures(1, @TexID);
       SDL_FreeSurface(ConvSurface);
      end;

      YPos := YPos + Surface^.h + 5;
      SDL_FreeSurface(Surface);

    end;
  end;

  // --- Восстанавливаем состояние OpenGL ---
  glPopMatrix;
  glMatrixMode(GL_PROJECTION);
  glPopMatrix;
  glMatrixMode(GL_MODELVIEW);
  glPopAttrib;

end;

// Инициализация подсистемы шрифтов (Часть 1 вашего примера)
procedure InitFont;
begin
  if TTF_Init() = -1 then
  begin
    WriteLn('Ошибка TTF_Init: ', TTF_GetError());
    Exit;
  end;
  Font := TTF_OpenFont('/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf', 16);
  if Font = nil then
    WriteLn('Ошибка загрузки шрифта: ', TTF_GetError());
end;

procedure Fire_Free;
begin
  if TextureID <> 0 then
    glDeleteTextures(1, @TextureID);
end;

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

  // Инициализируем шрифты из вашего примера
  InitFont;

  // Настройка атрибутов 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(
    'Doom 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;
  Fire_Init;
  Sparks_Init;

  // Главный игровой цикл (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 then
      begin
        case Event.key.keysym.sym of
          SDLK_ESCAPE: Running := False;

          // Выбор магии (ваши старые кнопки)
          // Изменяем: задаем ЦЕЛЕВУЮ палитру, к которой OpenGL начнет плавно стремиться
          SDLK_1, SDLK_KP_1: TargetPalette := PaletteClassic;
          SDLK_2, SDLK_KP_2: TargetPalette := PaletteBlue;
          SDLK_3, SDLK_KP_3: TargetPalette := PaletteGreen;
          SDLK_4, SDLK_KP_4: TargetPalette := PalettePurple;

          // === УПРАВЛЕНИЕ ВЕТРОМ ===
          // === ИСПРАВЛЕННОЕ, ИНТУИТИВНОЕ УПРАВЛЕНИЕ ВЕТРОМ ===
          SDLK_LEFT:  WindShift := 0;  // Огонь отклоняется ВЛЕВО
          SDLK_RIGHT: WindShift := 2;  // Огонь отклоняется ВПРАВО
          SDLK_UP:    WindShift := 1;  // Сброс ветра (ШТИЛЬ, строго вверх)
        end;
      end;
    end;

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

    // ВАЖНО: Перед рендерингом огня всегда принудительно возвращаем белый цвет,
    // чтобы текстура не наследовала черный цвет от плашки из предыдущего кадра!
    glColor4f(1.0, 1.0, 1.0, 1.0);

    Fire_Update; // Считаем физику пламени
    Fire_Render; // Рисуем прямоугольник с текстурой огня

    // === ДОБАВЛЯЕМ ВЫЗОВ ТУТ ===
    AnimatePalette; // Плавно пересчитываем цвета палитры на текущий кадр

    // === ДОБАВЛЯЕМ ИСКРЫ ТУТ ===
    Sparks_Update(WindShift); // Обновляем физику с учетом направления ветра
    Sparks_Render(SCREEN_WIDTH, SCREEN_HEIGHT); // Рисуем искры поверх огня
    // ===========================

    // Вызываем вашу процедуру подсказок с русским текстом
    DrawHints;

    SDL_GL_SwapWindow(Window); // Меняем буферы SDL2

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

  // Освобождение памяти
  if Font <> nil then TTF_CloseFont(Font);
  TTF_Quit();

  // Очистка памяти
  Fire_Free;

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

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

unit SparksSystem;

{$mode objfpc}{$H+}

interface

uses
  dglOpenGL, SysUtils;

const
  MAX_SPARKS = 150; // Максимальное количество искр на экране

type
  TSpark = record
    X, Y: Single;      // Позиция искры
    VX, VY: Single;    // Скорость по X и Y
    Life: Single;      // Время жизни / Прозрачность (от 1.0 до 0.0)
    Decay: Single;     // Скорость угасания
    Size: Single;      // Размер пикселя
  end;

// Инициализация системы искр
procedure Sparks_Init;
// Обновление физики искр (вызывать каждый кадр перед рендерингом)
procedure Sparks_Update(WindShift: Integer);
// Отрисовка искр в OpenGL
procedure Sparks_Render(ScreenWidth, ScreenHeight: Integer);

implementation

var
  Sparks: array[0..MAX_SPARKS - 1] of TSpark;

procedure Sparks_Init;
var
  I: Integer;
begin
  // Изначально все искры «мертвы» (Life = 0)
  for I := 0 to MAX_SPARKS - 1 do
    Sparks[I].Life := 0.0;
end;

procedure Sparks_Update(WindShift: Integer);
var
  I: Integer;
  WindForce: Single;
begin
  // Рассчитываем силу ветра на основе вашей переменной WindShift
  // WindShift = 0 (ветер влево), 1 (нет ветра), 2 (ветер вправо)
  WindForce := (WindShift - 1) * 0.4;

  for I := 0 to MAX_SPARKS - 1 do
  begin
    // Если искра мертва, генерируем её заново у основания огня
    if Sparks[I].Life <= 0.0 then
    begin
      Sparks[I].X := Random(800); // Случайное место по ширине экрана
      Sparks[I].Y := 410 + Random(40); // Чуть выше самого низа (в зоне пламени)
      Sparks[I].VX := (Random(100) - 50) / 100.0; // Небольшой хаос влево/вправо
      Sparks[I].VY := -(1.5 + Random(200) / 100.0); // Скорость взлета вверх (отрицательный Y)
      Sparks[I].Life := 0.6 + (Random(40) / 100.0); // Случайная яркость от 0.6 до 1.0
      Sparks[I].Decay := 0.005 + (Random(10) / 1000.0); // Скорость остывания
      Sparks[I].Size := 1.5 + Random(2); // Разные размеры искр для объема
    end
    else
    begin
      // Физика движения искры
      Sparks[I].X := Sparks[I].X + Sparks[I].VX + WindForce;
      Sparks[I].Y := Sparks[I].Y + Sparks[I].VY;

      // Небольшое хаотичное покачивание в воздухе
      Sparks[I].VX := Sparks[I].VX + (Random(100) - 50) / 500.0;

      // Уменьшаем время жизни (искра остывает и гаснет)
      Sparks[I].Life := Sparks[I].Life - Sparks[I].Decay;
    end;
  end;
end;

procedure Sparks_Render(ScreenWidth, ScreenHeight: Integer);
var
  I: Integer;
begin
  // Сохраняем состояние, отключаем текстуры, чтобы рисовать чистые точки
  glPushAttrib(GL_ENABLE_BIT or GL_CURRENT_BIT);
  glDisable(GL_TEXTURE_2D);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE); // Режим смешивания "Add" (эффект свечения)

  for I := 0 to MAX_SPARKS - 1 do
  begin
    if Sparks[I].Life > 0.0 then
    begin
      // Задаем размер точки в пикселях
      glPointSize(Sparks[I].Size);

      // Задаем цвет искры.
      // Желто-оранжевый цвет, который плавно угасает через Альфа-канал (Life)
      // Искры будут унаследовать яркость от своего времени жизни
      glColor4f(1.0, 0.6 + (Sparks[I].Life * 0.4), 0.2, Sparks[I].Life);

      glBegin(GL_POINTS);
        glVertex2f(Sparks[I].X, Sparks[I].Y);
      glEnd;
    end;
  end;

  glPopAttrib;
end;

end.

 

Два элемента для панели XFCE на Lazarus 4.6 и Debian 13

1) Размещение приложения созданого в Lazarus 4.6 на панель XFCE под Debian 13

Чтобы добавить пользовательский элемент на панель XFCE, необходимо нажать правай кнопкой мыши на панели XFCE, выбрать пункт меню Панель → Добавить новый элемент. В окне добавления новых элементов найдите универсальный монитор и добавте его на панель XFCE (Смотрите рисунок 1).

 

Рисунок 1. Окно добавления универсального монитора

Теперь нажмите на добавленом универсальном мониторе правой кнопкой мыши и выберите пункт меню свойства. В окне настройки универсального монитора в поле команда пропишите путь до вашего приложения с необходимыми параметрами, если необходимо. Отключите метку сняв с неё опцию. Установите периюд на 1 секунду для приложения цифровых часов и 5 секунд для приложения статуса интернета (Смотрите рисунок 2 и рисунок 3) .

Рисунок 2. Окно настройки универсального монитора для элемента цифровые часы

 

Рисунок 3. Окно настройки универсального монитора для элемента статус интернета

 

2) Пример элементов цифровые часы и статуса интернета

Как выгледят цифровые часы и статус интернета на панели XFCE можно посмотреть на рисунке 4 для горизонтальной панели XFCE и на рисунке 5 для вертикальной панели XFCE.

Рисунок 4. Пример работы элемента цифровых часов и статуса интернета на горизонтальной панели XFCE 

Рисунок 5. Пример работы элемента цифровых часов и статуса интернета на вертикальной панели XFCE 

Код элемента цифровые часы:

program p3;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, Process, FPimage, FPImgCanv, FPWritePNG;

type
  TDigitsArray = array[0..9, 0..4, 0..2] of Integer;

const
  DIGITS: TDigitsArray = (
    ((1,1,1), (1,0,1), (1,0,1), (1,0,1), (1,1,1)), // 0
    ((0,1,0), (0,1,0), (0,1,0), (0,1,0), (0,1,0)), // 1
    ((1,1,1), (0,0,1), (1,1,1), (1,0,0), (1,1,1)), // 2
    ((1,1,1), (0,0,1), (1,1,1), (0,0,1), (1,1,1)), // 3
    ((1,0,1), (1,0,1), (1,1,1), (0,0,1), (0,0,1)), // 4
    ((1,1,1), (1,0,0), (1,1,1), (0,0,1), (1,1,1)), // 5
    ((1,1,1), (1,0,0), (1,1,1), (1,0,1), (1,1,1)), // 6
    ((1,1,1), (0,0,1), (0,0,1), (0,0,1), (0,0,1)), // 7
    ((1,1,1), (1,0,1), (1,1,1), (1,0,1), (1,1,1)), // 8
    ((1,1,1), (1,0,1), (1,1,1), (0,0,1), (1,1,1))  // 9
  );

function IsPanelVertical: Boolean;
var OutputStr: string;
begin
  Result := False;
  try
    if RunCommand('xfconf-query', ['-c', 'xfce4-panel', '-p', '/panels/panel-1/mode'], OutputStr) then
    begin
      OutputStr := Trim(OutputStr);
      if (OutputStr = '1') or (OutputStr = '2') then Result := True;
    end;
  except
  end;
end;

function GetPanelSize: Integer;
var OutputStr: string;
begin
  Result := 48;
  try
    if RunCommand('xfconf-query', ['-c', 'xfce4-panel', '-p', '/panels/panel-1/size'], OutputStr) then
      Result := StrToIntDef(Trim(OutputStr), 48);
  except
  end;
end;

function IsXfceThemeDark: Boolean;
var OutputStr: string;
begin
  Result := True;
  try
    if RunCommand('xfconf-query', ['-c', 'xsettings', '-p', '/Net/ThemeName'], OutputStr) then
    begin
      OutputStr := LowerCase(Trim(OutputStr));
      if (Pos('light', OutputStr) > 0) or (Pos('white', OutputStr) > 0) or (Pos('clear', OutputStr) > 0) then
        Result := False;
    end;
  except
  end;
end;

procedure DrawSolidRectFP(Canvas: TFPImageCanvas; X1, Y1, X2, Y2: Integer; Color: TFPColor);
var X, Y: Integer;
begin
  for Y := Y1 to Y2 do
    for X := X1 to X2 do
      Canvas.Colors[X, Y] := Color;
end;

procedure DrawDigitFP(Canvas: TFPImageCanvas; Digit, StartX, SquareSize, Spacing: Integer; NeonColor: TFPColor; SolidMode: Boolean);
var
  R, C, X, Y, X2, Y2: Integer;
begin
  for R := 0 to 4 do
    for C := 0 to 2 do
      if DIGITS[Digit, R, C] = 1 then
      begin
        X := StartX + C * (SquareSize + Spacing);
        Y := R * (SquareSize + Spacing);

        if SolidMode then
        begin
          // В сплошном режиме расширяем границы отрисовки пикселей до краев ячейки,
          // чтобы они полностью перекрывали внутренний Spacing и сливались в линии
          X2 := X + SquareSize + Spacing - 1;
          Y2 := Y + SquareSize + Spacing - 1;

          // Защита от выхода линий за правый/нижний край матрицы цифры
          if C = 2 then X2 := X + SquareSize - 1;
          if R = 4 then Y2 := Y + SquareSize - 1;
        end
        else
        begin
          // В обычном режиме сохраняем жесткие зазоры (-2 пикселя) для разделения кубиков
          X2 := X + SquareSize - 2;
          Y2 := Y + SquareSize - 2;
        end;

        DrawSolidRectFP(Canvas, X, Y, X2, Y2, NeonColor);
      end;
end;

procedure DrawColonFP(Canvas: TFPImageCanvas; StartX, SquareSize, Spacing: Integer; Visible: Boolean; NeonColor: TFPColor; SolidMode: Boolean);
var Y1, Y2, SizeMod: Integer;
begin
  if not Visible then Exit;
  Y1 := 1 * (SquareSize + Spacing);
  Y2 := 3 * (SquareSize + Spacing);

  if SolidMode then SizeMod := -1 else SizeMod := -2;

  DrawSolidRectFP(Canvas, StartX, Y1, StartX + SquareSize + SizeMod, Y1 + SquareSize + SizeMod, NeonColor);
  DrawSolidRectFP(Canvas, StartX, Y2, StartX + SquareSize + SizeMod, Y2 + SquareSize + SizeMod, NeonColor);
end;

function ResizeImageFP(SrcImg: TFPMemoryImage; NewWidth, NewHeight: Integer): TFPMemoryImage;
var
  X, Y, SrcX, SrcY: Integer;
begin
  Result := TFPMemoryImage.Create(NewWidth, NewHeight);
  for Y := 0 to NewHeight - 1 do
    for X := 0 to NewWidth - 1 do Result.Colors[X, Y] := FPColor(0,0,0,0);

  for Y := 0 to NewHeight - 1 do
  begin
    SrcY := (Y * SrcImg.Height) div NewHeight;
    if SrcY >= SrcImg.Height then SrcY := SrcImg.Height - 1;

    for X := 0 to NewWidth - 1 do
    begin
      SrcX := (X * SrcImg.Width) div NewWidth;
      if SrcX >= SrcImg.Width then SrcX := SrcImg.Width - 1;

      Result.Colors[X, Y] := SrcImg.Colors[SrcX, SrcY];
    end;
  end;
end;

procedure CreateClockImage(Hour, Min, Sec: Word; const OutPath: string; SquareSize, Spacing: Integer; Vertical, ShowSeconds, SolidMode: Boolean; NeonColor: TFPColor);
var
  FullImg, FinalImg: TFPMemoryImage;
  Canvas: TFPImageCanvas;
  Writer: TFPWriterPNG;
  DigitWidth, DigitHeight, CurX: Integer;
  InternalDigitSpacing, BlockSpacing, MarginSpacing: Integer;
  IsColonVisible: Boolean;
  PanelSize, NewWidth, NewHeight, X, Y: Integer;
begin
  DigitWidth := (3 * SquareSize) + (2 * Spacing);
  DigitHeight := (5 * SquareSize) + (4 * Spacing);

  InternalDigitSpacing := 6;
  BlockSpacing := 10;
  MarginSpacing := 8;

  IsColonVisible := (Sec mod 2 = 0);

  FullImg := TFPMemoryImage.Create(0, 0);
  try
    if ShowSeconds then
      X := (DigitWidth * 6) + (SquareSize * 2) + (InternalDigitSpacing * 3) + (BlockSpacing * 4) + (MarginSpacing * 2)
    else
      X := (DigitWidth * 4) + (SquareSize * 1) + (InternalDigitSpacing * 2) + (BlockSpacing * 2) + (MarginSpacing * 2);

    FullImg.SetSize(X, DigitHeight);

    for Y := 0 to FullImg.Height - 1 do
      for X := 0 to FullImg.Width - 1 do FullImg.Colors[X, Y] := FPColor(0,0,0,0);

    Canvas := TFPImageCanvas.Create(FullImg);
    try
      CurX := MarginSpacing;

      // --- ЧАСЫ ---
      DrawDigitFP(Canvas, Hour div 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
      CurX := CurX + DigitWidth + InternalDigitSpacing;
      DrawDigitFP(Canvas, Hour mod 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
      CurX := CurX + DigitWidth + BlockSpacing;

      // --- РАЗДЕЛИТЕЛЬ 1 ---
      DrawColonFP(Canvas, CurX, SquareSize, Spacing, IsColonVisible, NeonColor, SolidMode);
      CurX := CurX + SquareSize + BlockSpacing;

      // --- МИНУТЫ ---
      DrawDigitFP(Canvas, Min div 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
      CurX := CurX + DigitWidth + InternalDigitSpacing;
      DrawDigitFP(Canvas, Min mod 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);

      if ShowSeconds then
      begin
        CurX := CurX + DigitWidth + BlockSpacing;

        // --- РАЗДЕЛИТЕЛЬ 2 ---
        DrawColonFP(Canvas, CurX, SquareSize, Spacing, IsColonVisible, NeonColor, SolidMode);
        CurX := CurX + SquareSize + BlockSpacing;

        // --- СЕКУНДЫ ---
        DrawDigitFP(Canvas, Sec div 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
        CurX := CurX + DigitWidth + InternalDigitSpacing;
        DrawDigitFP(Canvas, Sec mod 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
      end;
    finally
      Canvas.Free;
    end;

    Writer := TFPWriterPNG.Create;
    try
      Writer.Indexed := False;
      Writer.UseAlpha:= True;

      // Получаем реальный физический размер панели XFCE из системы (хоть вертикальной, хоть горизонтальной)
      PanelSize := GetPanelSize();

      if Vertical then
      begin
        // --- ВЕРТИКАЛЬНАЯ ПАНЕЛЬ ---
        // Жестко вписываем ШИРИНУ картинки в ШИРИНУ панели (PanelSize)
        NewWidth := PanelSize;
        NewHeight := Round((FullImg.Height * NewWidth) / FullImg.Width);
      end
      else
      begin
        // --- ГОРИЗОНТАЛЬНАЯ ПАНЕЛЬ ---
        // Жестко вписываем ВЫСОТУ картинки в ВЫСОТУ панели (PanelSize) с небольшим отступом (85% от высоты панели)
        NewHeight := Round(PanelSize * 0.85);
        if NewHeight < 16 then NewHeight := 16; // Защита от слишком мелких панелей

        NewWidth := Round((FullImg.Width * NewHeight) / FullImg.Height);
      end;

      // Запускаем наше качественное пиксельное масштабирование для ОБОИХ режимов
      FinalImg := ResizeImageFP(FullImg, NewWidth, NewHeight);
      try
        FinalImg.SaveToFile(OutPath, Writer);
      finally
        FinalImg.Free;
      end;

    finally
      Writer.Free;
    end;
  finally
    FullImg.Free;
  end;
end;

var
  Hour, Min, Sec, MSec: Word;
  ImagePath: string;
  SqSize, Spac: Integer;
  VerticalMode, ShowSeconds, SolidMode: Boolean;
  I: Integer;
  ActiveColor: TFPColor;
  ColorForced: Boolean;
begin
  try
    ImagePath := '/tmp/xfce_neon_clock.png';
    VerticalMode := IsPanelVertical;

    ShowSeconds := True;
    SolidMode := False; // По умолчанию режим раздельных кубиков
    ColorForced := False;
    ActiveColor.alpha := $FFFF;

    for I := 1 to ParamCount do
    begin
      if (ParamStr(I) = '--no-sec') or (ParamStr(I) = '-no-sec') then ShowSeconds := False;
      if (ParamStr(I) = '--solid')  or (ParamStr(I) = '-solid')  then SolidMode := True;

      if (ParamStr(I) = '--green') then begin ActiveColor.red := $3333; ActiveColor.green := $FFFF; ActiveColor.blue := $3333; ColorForced := True; end;
      if (ParamStr(I) = '--blue')  then begin ActiveColor.red := $3333; ActiveColor.green := $9999; ActiveColor.blue := $FFFF; ColorForced := True; end;
      if (ParamStr(I) = '--amber') then begin ActiveColor.red := $FFFF; ActiveColor.green := $A9A9; ActiveColor.blue := $3333; ColorForced := True; end;

      if (ParamStr(I) = '--dark-blue')  then begin ActiveColor.red := $0000; ActiveColor.green := $2222; ActiveColor.blue := $8888; ColorForced := True; end;
      if (ParamStr(I) = '--dark-graph') then begin ActiveColor.red := $2222; ActiveColor.green := $2222; ActiveColor.blue := $2222; ColorForced := True; end;
    end;

    if not ColorForced then
    begin
      if IsXfceThemeDark() then
      begin
        ActiveColor.red := $3333; ActiveColor.green := $FFFF; ActiveColor.blue := $3333;
      end
      else
      begin
        ActiveColor.red := $0000; ActiveColor.green := $2222; ActiveColor.blue := $8888;
      end;
    end;

    SqSize := 10; Spac := 2;
    DecodeTime(Now, Hour, Min, Sec, MSec);

    CreateClockImage(Hour, Min, Sec, ImagePath, SqSize, Spac, VerticalMode, ShowSeconds, SolidMode, ActiveColor);

    WriteLn('<img>' + ImagePath + '</img>');
    WriteLn('<tool>'Цифровые часы'</tool>');
  except
    on E: Exception do WriteLn('<txt>'[ Ошибка часов ]'</txt>');
  end;
end.

Код элемента статус интернета:

program p2;
{$mode objfpc}{$H+}

uses
  Classes, SysUtils, Process, FPimage, FPWritePNG;

function IsInternetAvailable(): Boolean;
var
  DummyOutput: string;
begin
  // RunCommand запускает ping скрытно и собирает его вывод в переменную DummyOutput.
  // На экран (и в Genmon) ничего лишнего не попадает.
  Result := RunCommand('/usr/bin/ping', ['-c', '1', '-W', '2', '8.8.8.8'], DummyOutput);
end;

// Процедура генерации красивого объёмного огонька напрямую по пикселям
procedure CreateLedIcon(const APath: string; IsGreen: Boolean);
var
  Img: TFPMemoryImage;
  Writer: TFPWriterPNG;
  X, Y, DX, DY: Integer;
  Dist: Double;
  RColor, GColor, BColor: Word;
  Alpha: Word;
  EdgeAlpha: Integer; // Добавили эту переменную для сглаживания
begin
  Img := TFPMemoryImage.Create(16, 16);
  Writer := TFPWriterPNG.Create;
  try
    // Заполняем фон: абсолютно прозрачный (последний параметр $0000)
    for Y := 0 to 15 do
      for X := 0 to 15 do
        Img.Colors[X, Y] := FPColor(0, 0, 0, $0000);

        // Рисуем 3D-сферу со сглаженными краями (Антиалиасинг)
    for Y := 0 to 15 do
    begin
      for X := 0 to 15 do
      begin
        Dist := Sqrt(Sqr(X - 7.5) + Sqr(Y - 7.5));

        // Ограничиваем радиус сглаживания (до 7.2 пикселей, чтобы не обрезать края)
        if Dist <= 7.2 then
        begin
          DX := X - 5;
          DY := Y - 5;
          Alpha := Trunc(255 * (1.0 - (Sqrt(Sqr(DX) + Sqr(DY)) / 12.0)));
          if Alpha > 255 then Alpha := 255;
          if Alpha < 50 then Alpha := 50;

          if IsGreen then
          begin
            RColor := (Alpha * $33) div 255;
            GColor := (Alpha * $FF) div 255;
            BColor := (Alpha * $33) div 255;
          end
          else
          begin
            RColor := (Alpha * $FF) div 255;
            GColor := (Alpha * $22) div 255;
          end;

          // --- БЛОК СГЛАЖИВАНИЯ КРАЕВ ---
          // Если пиксель находится на внешнем краю круга (между 6.0 и 7.2 пикселей)
          if Dist > 6.0 then
          begin
            // Вычисляем коэффициент прозрачности края от 1.0 (на расстоянии 6.0) до 0.0 (на расстоянии 7.2)
            // Формула: (7.2 - Dist) / (7.2 - 6.0)
            EdgeAlpha := Trunc($FFFF * ((7.2 - Dist) / 1.2));
            if EdgeAlpha < 0 then EdgeAlpha := 0;
          end
          else
          begin
            // Внутри круга пиксели полностью непрозрачны
            EdgeAlpha := $FFFF;
          end;

          // Записываем цвет, подставляя вычисленный EdgeAlpha вместо жесткого $FFFF
          Img.Colors[X, Y] := FPColor(RColor shl 8, GColor shl 8, BColor shl 8, EdgeAlpha);
        end;
      end;
    end;

    Writer.UseAlpha := True;

    Img.SaveToFile(APath, Writer);
  finally
    Writer.Free;
    Img.Free;
  end;
end;

var
  Online: Boolean;
  IconPath: string;
  TextMon, TooltipText: string;
begin
  Online := IsInternetAvailable();

  if Online then IconPath := '/tmp/genmon-net-on.png'
  else IconPath := '/tmp/genmon-net-off.png';

  CreateLedIcon(IconPath, Online);

  if Online then
  begin
    TextMon := 'Инт.вкл.';
    TooltipText := 'Интернет подключен';
  end
  else
  begin
    TextMon := 'Инт.откл.';
    TooltipText := 'Соединение отсутствует';
  end;

	writeln('<txt>' + textmon + '</txt>');
	writeln('<img>' + iconpath + '</img>');
	writeln('<tool>' + tooltiptext + '</tool>');
end.

 

Порт графической сцены “Огонь” с 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.

 

Порт графической сцены “Гром” с языка DarkBasic Pro на Lazarus 4.6 + SDL 2 + dglOpenGL + Debian 13

Пример кода порта графической сцены “Гром” с языка DarkBasic Pro на Lazarus 4.6 + SDL 2 + dglOpenGL + Debian 13. Медиа ресурсы которые использованы в графической сцене и сам исходный код на языке DarkBasic Pro можно скачать с сайта https://ant2on.narod.ru/source.htm или по прямой ссылке http://ant2on.narod.ru/download/storm.zip.

  

Рисунок 1. Пример работы программы "Гром"

 

program ogl_p5;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes,
  SysUtils,
  dglOpenGL,
  sdl2,
  sdl2_mixer,
  sdl2_ttf,
  Math;

const
  WINDOW_WIDTH  = 800;
  WINDOW_HEIGHT = 600;

type
  TRainDrop = record
    X, Y, Z: Single;
  end;

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

  // Настройки симуляции
  NoRain: Integer = 100;
  CloudSize: Single = 500.0;
  CloudHeight: Single = 100.0;

  RainDrops: array of TRainDrop;
  SoundRain: PMIX_Music = nil;
  SoundThunder: PMix_Chunk = nil;
  FloorTextureID: GLuint;
  MatrixHeights: array[0..25, 0..25] of Single;

  // ---------- НОВАЯ СИСТЕМА КАМЕРЫ ----------
  CamX: Single = 5000.0;      // позиция камеры
  CamY: Single = 500.0;       // подняли начальную высоту для лучшего обзора
  CamZ: Single = 500.0;

  CamPitch: Single = 0.0;     // угол наклона (вверх/вниз)
  CamYaw: Single = -90.0;     // угол поворота (влево/вправо) – смотрим вдоль +Z? начальный угол -90 чтобы смотреть в сторону увеличения Z

  // Скорость и чувствительность
  MoveSpeed: Single = 300.0;   // единиц в секунду
  MouseSensitivity: Single = 0.2;

  // Флаги движения
  moveForward, moveBack, moveLeft, moveRight{, moveUp, moveDown}: Boolean;
  // НОВОЕ: Флаг захвата мыши
  MouseCaptured: Boolean = True;

  // Для дельты времени
  LastTime: UInt32 = 0;
  DeltaTime: Single = 0.0;

  ThunderActive: Boolean = False;
  Font: PTTF_Font = nil;

procedure InitFont;
begin
  if TTF_Init() = -1 then
  begin
    WriteLn('Ошибка TTF_Init: ', TTF_GetError());
    Exit;
  end;
  // Укажите путь к любому TTF-шрифту в вашей системе
  Font := TTF_OpenFont('/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf', 16);
  if Font = nil then
    WriteLn('Ошибка загрузки шрифта: ', TTF_GetError());
end;

procedure InitSystem;
var
  audio_rate: Integer;
  audio_format: Word;
  audio_channels: Integer;
  audio_buffers: Integer;
begin
  SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);

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

  audio_rate := 44100;
  audio_format := AUDIO_S16SYS;
  audio_channels := 2;
  audio_buffers := 2048;
  if Mix_OpenAudio(audio_rate, audio_format, audio_channels, audio_buffers) < 0 then
  begin
    WriteLn('Ошибка Mix_OpenAudio: ', Mix_GetError());
    SDL_Quit();
    Exit;
  end;

  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);
  SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 24);

  Window := SDL_CreateWindow(
    'SDL2 + dglOpenGL + Lazarus 4.6 + Debian 13',
    SDL_WINDOWPOS_CENTERED, SDL_WINDOWPOS_CENTERED,
    WINDOW_WIDTH, WINDOW_HEIGHT,
    SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN or SDL_WINDOW_RESIZABLE
  );
  if Window = nil then
    raise Exception.Create('Не удалось создать окно SDL2');

  GLContext := SDL_GL_CreateContext(Window);
  if GLContext = nil then
    raise Exception.Create('Не удалось создать контекст OpenGL');

  if not InitOpenGL then
    raise Exception.Create('Не удалось инициализировать dglOpenGL');
  ReadExtensions;
  ReadImplementationProperties;

  InitFont;

  // FIX: дальняя плоскость увеличена до 50000 (было 100)
  glViewport(0, 0, WINDOW_WIDTH, WINDOW_HEIGHT);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, WINDOW_WIDTH / WINDOW_HEIGHT, 0.1, 50000.0);
  glMatrixMode(GL_MODELVIEW);
  glClearColor(0.1, 0.1, 0.15, 1.0);

  // Включаем глубину
  glEnable(GL_DEPTH_TEST);
end;

procedure HandleResize(Width, Height: Integer);
begin
  if Height = 0 then Height := 1;
  glViewport(0, 0, Width, Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, Width / Height, 0.1, 50000.0);  // FIX
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
end;

// NEW: обработка ввода с клавиатуры (непрерывное состояние)
procedure ProcessKeyboardInput;
var
  KeyState: PUint8;
begin
  KeyState := SDL_GetKeyboardState(nil);
  moveForward := KeyState[SDL_SCANCODE_W] = 1;
  moveBack    := KeyState[SDL_SCANCODE_S] = 1;
  moveLeft    := KeyState[SDL_SCANCODE_A] = 1;
  moveRight   := KeyState[SDL_SCANCODE_D] = 1;
  //moveUp      := KeyState[SDL_SCANCODE_Q] = 1;   // подъём
  //moveDown    := KeyState[SDL_SCANCODE_E] = 1;   // спуск
end;

// NEW: обработка событий окна и клавиатуры
procedure HandleEvents;
begin
  while SDL_PollEvent(@Event) <> 0 do
  begin
    case Event.type_ of
      SDL_QUITEV: Running := False;
      SDL_WINDOWEVENT:
        if Event.window.event in [SDL_WINDOWEVENT_RESIZED, SDL_WINDOWEVENT_SIZE_CHANGED] then
          HandleResize(Event.window.data1, Event.window.data2);
      SDL_KEYDOWN:
        case Event.key.keysym.sym of
          SDLK_ESCAPE:
            begin
              if MouseCaptured then
              begin
                // Если мышь захвачена - освобождаем её, чтобы можно было нажать на кнопки окна
                SDL_SetRelativeMouseMode(SDL_FALSE);
                SDL_ShowCursor(SDL_ENABLE);
                MouseCaptured := False;
              end
              else
              begin
                // Если мышь уже свободна, повторное нажатие Esc закрывает игру
                Running := False;
              end;
            end;

          SDLK_F11:
            begin
              // Переключение полноэкранного режима (Borderless Fullscreen)
              if (SDL_GetWindowFlags(Window) and SDL_WINDOW_FULLSCREEN_DESKTOP) <> 0 then
                SDL_SetWindowFullscreen(Window, 0) // Выход из полноэкранного режима
              else
                SDL_SetWindowFullscreen(Window, SDL_WINDOW_FULLSCREEN_DESKTOP); // Разворот на весь экран
            end;
        end;

      SDL_MOUSEBUTTONDOWN:
        begin
          // Если мышь свободна и пользователь кликнул по окну, захватываем её обратно
          if not MouseCaptured then
          begin
            SDL_SetRelativeMouseMode(SDL_TRUE);
            SDL_ShowCursor(SDL_DISABLE);
            MouseCaptured := True;
          end;
        end;

      SDL_MOUSEMOTION:
        begin
          // Вращение камеры мышью (только если мышь захвачена)
          if MouseCaptured then
          begin
            CamYaw   := CamYaw   + Event.motion.xrel * MouseSensitivity;
            CamPitch := CamPitch - Event.motion.yrel * MouseSensitivity;
            if CamPitch > 89.0 then CamPitch := 89.0;
            if CamPitch < -89.0 then CamPitch := -89.0;
          end;
        end;
    end;
  end;
end;

procedure DrawHints;
var
  W, H: Integer;
  Lines: array of string;
  I: Integer;
  Surface: PSDL_Surface;
  TexID: GLuint;
  Color: TSDL_Color;
  XPos, YPos: Integer;
  BgHeight: Integer;
  MaxWidth: Integer;
  LineHeights: array of Integer;
  TotalHeight: Integer;
  ConvSurface: PSDL_Surface;
begin
  if Font = nil then Exit;

  SDL_GetWindowSize(Window, @W, @H);

  Lines := [
    'ESC - Освободить мышку (Нажмите повторно для выхода)',
    'LMB - Захватить мышку',
    'F11 - Во весь экран (Нажмите повторно для режима окна)'
  ];

  // Сначала вычисляем размеры всех строк
  SetLength(LineHeights, Length(Lines));
  MaxWidth := 0;
  TotalHeight := 0;
  Color.r := 255; Color.g := 255; Color.b := 255; Color.a := 255;

  for I := 0 to High(Lines) do
  begin
    Surface := TTF_RenderUTF8_Blended(Font, PChar(Lines[I]), Color);
    if Surface <> nil then
    begin
      LineHeights[I] := Surface^.h;
      if Surface^.w > MaxWidth then MaxWidth := Surface^.w;
      TotalHeight := TotalHeight + Surface^.h + 5;
      SDL_FreeSurface(Surface);
    end
    else
      LineHeights[I] := 0;
  end;

  // --- Сохраняем состояние OpenGL ---
  glPushAttrib(GL_ENABLE_BIT or GL_TEXTURE_BIT or GL_CURRENT_BIT);
  glMatrixMode(GL_PROJECTION);
  glPushMatrix;
  glLoadIdentity;
  glOrtho(0, W, H, 0, -1, 1);  // 2D-проекция: (0,0) — верхний левый угол
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;

  glDisable(GL_DEPTH_TEST);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

  XPos := 10;
  YPos := 10;

  // --- Полупрозрачная чёрная подложка ---
  BgHeight := TotalHeight + 10;
  glDisable(GL_TEXTURE_2D);
  glColor4f(0.0, 0.0, 0.0, 0.6);
  glBegin(GL_QUADS);
    glVertex2f(XPos, YPos);
    glVertex2f(XPos + MaxWidth + 20, YPos);
    glVertex2f(XPos + MaxWidth + 20, YPos + BgHeight);
    glVertex2f(XPos, YPos + BgHeight);
  glEnd;

  // --- Рендерим каждую строку текста ---
  YPos := YPos + 8;

  for I := 0 to High(Lines) do
  begin
    Surface := TTF_RenderUTF8_Blended(Font, PChar(Lines[I]), Color);
    if Surface <> nil then
    begin
      // Конвертируем поверхность в правильный формат
      ConvSurface := SDL_ConvertSurfaceFormat(Surface, SDL_PIXELFORMAT_ABGR8888, 0);
      if ConvSurface <> nil then
      begin
        glGenTextures(1, @TexID);
        glBindTexture(GL_TEXTURE_2D, TexID);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

        // Учитываем pitch поверхности
        glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
        glPixelStorei(GL_UNPACK_ROW_LENGTH, ConvSurface^.pitch div 4);

        glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, ConvSurface^.w, ConvSurface^.h, 0,
                     GL_RGBA, GL_UNSIGNED_BYTE, ConvSurface^.pixels);

        glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
        glPixelStorei(GL_UNPACK_ALIGNMENT, 4);

        SDL_FreeSurface(ConvSurface);

        glEnable(GL_TEXTURE_2D);
        glColor4f(1.0, 1.0, 1.0, 1.0);
        glBegin(GL_QUADS);
          // Правильные текстурные координаты (без инверсии Y, т.к. мы уже конвертировали)
          glTexCoord2f(0.0, 0.0); glVertex2f(XPos + 10, YPos);
          glTexCoord2f(1.0, 0.0); glVertex2f(XPos + 10 + Surface^.w, YPos);
          glTexCoord2f(1.0, 1.0); glVertex2f(XPos + 10 + Surface^.w, YPos + Surface^.h);
          glTexCoord2f(0.0, 1.0); glVertex2f(XPos + 10, YPos + Surface^.h);
        glEnd;

        glDeleteTextures(1, @TexID);
      end;

      YPos := YPos + Surface^.h + 5;
      SDL_FreeSurface(Surface);
    end;
  end;

  // --- Восстанавливаем состояние OpenGL ---
  glPopMatrix;
  glMatrixMode(GL_PROJECTION);
  glPopMatrix;
  glMatrixMode(GL_MODELVIEW);
  glPopAttrib;
end;

function GetGroundHeight(X, Z: Single): Single;
var
  GridSize: Single;
  CellX, CellZ: Integer;
  FracX, FracZ: Single;
  H00, H10, H01, H11: Single;
  HeightT, HeightB: Single;
begin
  GridSize := 400.0;
  if (X < 0) or (X >= 10000.0) or (Z < 0) or (Z >= 10000.0) then
    Exit(0.0);
  CellX := Trunc(X / GridSize);
  CellZ := Trunc(Z / GridSize);
  if CellX > 24 then CellX := 24;
  if CellZ > 24 then CellZ := 24;
  FracX := (X / GridSize) - CellX;
  FracZ := (Z / GridSize) - CellZ;
  H00 := MatrixHeights[CellX,     CellZ];
  H10 := MatrixHeights[CellX + 1, CellZ];
  H01 := MatrixHeights[CellX,     CellZ + 1];
  H11 := MatrixHeights[CellX + 1, CellZ + 1];
  HeightT := H00 + FracX * (H10 - H00);
  HeightB := H01 + FracX * (H11 - H01);
  Result := HeightT + FracZ * (HeightB - HeightT);
end;

// NEW: обновление позиции камеры с использованием дельты времени
procedure UpdateCamera;
var
  RadYaw: Single;
  Vel: Single;
  ForwardX, ForwardZ: Single;
  RightX, RightZ: Single;
  NewX, NewZ: Single;
  GroundY: Single;
const
  EyeHeight = 100.0;   // высота глаз над поверхностью
  EdgeMargin = 50.0;
begin
  Vel := MoveSpeed * DeltaTime;
  // Направление "вперёд" в горизонтальной плоскости (без учёта наклона)
  RadYaw := DegToRad(CamYaw);
  ForwardX := Cos(RadYaw);
  ForwardZ := Sin(RadYaw);
  RightX := -Sin(RadYaw);
  RightZ := Cos(RadYaw);

  NewX := CamX;
  NewZ := CamZ;

  if moveForward then
  begin
    NewX := NewX + ForwardX * Vel;
    NewZ := NewZ + ForwardZ * Vel;
  end;
  if moveBack then
  begin
    NewX := NewX - ForwardX * Vel;
    NewZ := NewZ - ForwardZ * Vel;
  end;
  if moveLeft then
  begin
    NewX := NewX - RightX * Vel;
    NewZ := NewZ - RightZ * Vel;
  end;
  if moveRight then
  begin
    NewX := NewX + RightX * Vel;
    NewZ := NewZ + RightZ * Vel;
  end;

  // Ограничиваем перемещение в пределах ландшафта (0..10000)
  if NewX < EdgeMargin then NewX := EdgeMargin;
  if NewX > 10000 - EdgeMargin then NewX := 10000 - EdgeMargin;
  // аналогично для Z
  if NewZ < EdgeMargin then NewZ := EdgeMargin;
  if NewZ > 10000 - EdgeMargin then NewZ := 10000 - EdgeMargin;

  CamX := NewX;
  CamZ := NewZ;

  // Привязываем высоту камеры к рельефу с добавлением EyeHeight
  GroundY := GetGroundHeight(CamX, CamZ);
  //CamY := GroundY + EyeHeight;
  // Плавное изменение высоты (сглаживание)
  CamY := CamY * 0.9 + (GroundY + EyeHeight) * 0.1;
end;

procedure ApplyCamera;
var
  LookDirX, LookDirY, LookDirZ: Single;
  RadYaw, RadPitch: Single;
begin
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  // Вычисляем вектор направления взгляда из углов Эйлера
  RadYaw   := DegToRad(CamYaw);
  RadPitch := DegToRad(CamPitch);
  LookDirX := Cos(RadPitch) * Cos(RadYaw);
  LookDirY := Sin(RadPitch);
  LookDirZ := Cos(RadPitch) * Sin(RadYaw);

  gluLookAt(CamX, CamY, CamZ,
            CamX + LookDirX, CamY + LookDirY, CamZ + LookDirZ,
            0.0, 1.0, 0.0);
end;

// ОСТАЛЬНЫЕ ФУНКЦИИ (MoveRain, DrawRain, GetGroundHeight, RegenRain, DrawMatrix, Thunder и т.д.)
// ------- без изменений, за исключением того, что RegenRain больше не привязан к камере, но это не мешает -------
const
  RainFallSpeed = 600.0; // единиц в секунду

procedure MoveRain;
var
  I: Integer;
begin
  for I := 0 to NoRain - 1 do
    RainDrops[I].Y := RainDrops[I].Y - RainFallSpeed * DeltaTime;
end;

procedure DrawRain;
var
  I: Integer;
begin
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE);
  glDepthMask(GL_FALSE);
  glColor4f(0.6, 0.7, 0.8, 0.3);
  glBegin(GL_LINES);
  for I := 0 to NoRain - 1 do
  begin
    glVertex3f(RainDrops[I].X, RainDrops[I].Y,       RainDrops[I].Z);
    glVertex3f(RainDrops[I].X, RainDrops[I].Y + 50.0, RainDrops[I].Z);
  end;
  glEnd;
  glDepthMask(GL_TRUE);
  glDisable(GL_BLEND);
end;

procedure RegenRain;
var
  I: Integer;
  GroundH: Single;
begin
  for I := 0 to NoRain - 1 do
  begin
    GroundH := GetGroundHeight(RainDrops[I].X, RainDrops[I].Z);
    if RainDrops[I].Y < GroundH then
    begin
      // Капли пересоздаются где-то над камерой, но камера теперь может летать высоко – пусть так
      RainDrops[I].X := CamX + Random(Trunc(CloudSize)) - Random(Trunc(CloudSize));
      RainDrops[I].Y := CamY + CloudHeight;
      RainDrops[I].Z := CamZ + Random(Trunc(CloudSize)) - Random(Trunc(CloudSize));
    end;
  end;
end;

procedure DrawMatrix;
var
  X, Z: Integer;
  GridSize: Single;
begin
  GridSize := 400.0;
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, FloorTextureID);
  glColor3f(1.0, 1.0, 1.0);
  glBegin(GL_QUADS);
  for X := 0 to 24 do
  begin
    for Z := 0 to 24 do
    begin
      glTexCoord2f(0.0, 0.0); glVertex3f(X * GridSize, MatrixHeights[X, Z], Z * GridSize);
      glTexCoord2f(1.0, 0.0); glVertex3f((X+1)*GridSize, MatrixHeights[X+1, Z], Z * GridSize);
      glTexCoord2f(1.0, 1.0); glVertex3f((X+1)*GridSize, MatrixHeights[X+1, Z+1], (Z+1)*GridSize);
      glTexCoord2f(0.0, 1.0); glVertex3f(X * GridSize, MatrixHeights[X, Z+1], (Z+1)*GridSize);
    end;
  end;
  glEnd;
  glDisable(GL_TEXTURE_2D);
end;

procedure DrawWhiteFlashMatrix;
var
  X, Z: Integer;
  GridSize: Single;
begin
  GridSize := 400.0;
  glDisable(GL_TEXTURE_2D);
  glColor3f(1.0, 1.0, 1.0);
  for X := 0 to 24 do
  begin
    glBegin(GL_QUADS);
    for Z := 0 to 24 do
    begin
      glVertex3f(X * GridSize, MatrixHeights[X, Z], Z * GridSize);
      glVertex3f((X+1)*GridSize, MatrixHeights[X+1, Z], Z * GridSize);
      glVertex3f((X+1)*GridSize, MatrixHeights[X+1, Z+1], (Z+1)*GridSize);
      glVertex3f(X * GridSize, MatrixHeights[X, Z+1], (Z+1)*GridSize);
    end;
    glEnd;
  end;
end;

procedure Thunder;
var
  Rand: Integer;
begin
  Rand := Random(201);
  if Rand = 120 then
  begin
    glClearColor(0.1, 0.1, 0.15, 1.0); // Возвращаем исходный цвет
    ThunderActive := True;
    if SoundThunder <> nil then
      Mix_PlayChannel(-1, SoundThunder, 0);
  end
  else
  begin
    glClearColor(0.0, 0.0, 0.0, 1.0);
    ThunderActive := False;
  end;
end;

procedure GenerateMatrix;
var
  x, z: Integer;
begin
  //Randomize;
  for x := 0 to 25 do
    for z := 0 to 25 do
      MatrixHeights[x, z] := Random * 200.0;
end;

procedure LoadFloorTexture;
var
  Surface: PSDL_Surface;
  MyFormat: GLint;
begin
  Surface := SDL_LoadBMP('floor1.bmp');
  if Surface = nil then Exit;
  glGenTextures(1, @FloorTextureID);
  glBindTexture(GL_TEXTURE_2D, FloorTextureID);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  MyFormat := GL_BGR;
  if Surface^.format^.BytesPerPixel = 4 then MyFormat := GL_BGRA;
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, Surface^.w, Surface^.h, 0, MyFormat, GL_UNSIGNED_BYTE, Surface^.pixels);
  SDL_FreeSurface(Surface);
end;

procedure UpdateFrame;
var
  CurrentTime: UInt32;
begin
  // Вычисляем дельту времени
  CurrentTime := SDL_GetTicks();
  DeltaTime := (CurrentTime - LastTime) / 1000.0;
  if DeltaTime > 0.1 then DeltaTime := 0.1; // защита от больших скачков
  LastTime := CurrentTime;

  ProcessKeyboardInput;
  UpdateCamera;
  MoveRain;
  RegenRain;
  Thunder;
end;

procedure RenderFrame;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;
  ApplyCamera;
  if not ThunderActive then
    DrawMatrix
  else
    DrawWhiteFlashMatrix;
  DrawRain;
  DrawHints;
  SDL_GL_SwapWindow(Window);
end;

procedure CleanUp;
begin
  if Font <> nil then
  begin
    TTF_CloseFont(Font);
    TTF_Quit();
  end;
  if SoundRain <> nil then Mix_FreeMusic(SoundRain);
  if SoundThunder <> nil then Mix_FreeChunk(SoundThunder);
  Mix_CloseAudio();
  glDeleteTextures(1, @FloorTextureID);
  if GLContext <> nil then SDL_GL_DeleteContext(GLContext);
  if Window <> nil then SDL_DestroyWindow(Window);
  SDL_Quit();
end;

var
  I: Integer;
begin
  try
    InitSystem;

    SoundRain := Mix_LoadMUS('rain.wav');
    if SoundRain <> nil then Mix_PlayMusic(SoundRain, -1);
    SoundThunder := Mix_LoadWAV('thunder.wav');

    SetLength(RainDrops, NoRain);

    Randomize;
    for I := 0 to NoRain - 1 do
    begin
      RainDrops[I].X := CamX + Random(Trunc(CloudSize)) - Random(Trunc(CloudSize));
      RainDrops[I].Y := CamY + CloudHeight - Random(Trunc(CloudHeight));
      RainDrops[I].Z := CamZ + Random(Trunc(CloudSize)) - Random(Trunc(CloudSize));
    end;

    GenerateMatrix;
    LoadFloorTexture;

    // FIX: Захватываем мышь (относительный режим) для нормального управления
    // Инициализация захвата мыши
    MouseCaptured := True;
    SDL_SetRelativeMouseMode(SDL_TRUE);
    SDL_ShowCursor(SDL_DISABLE); // Скрываем системный курсор

    LastTime := SDL_GetTicks();
    Running := True;
    while Running do
    begin
      HandleEvents;
      UpdateFrame;
      RenderFrame;
      SDL_Delay(16);
    end;

  except
    on E: Exception do
      Writeln('Ошибка: ', E.Message);
  end;

  CleanUp;
end.

Показываем информацию о системе и компьютере на Lazarus 4.6 под Debian 13

Пример кода программы на Lazarus 4.6 под Debian 13. Прграмма получает информацию об объёме физической памяти, процессоре, операционной системе. Мной код скомпилирован, программа работает.

Рисунок 1. Пример работы программы "Информация о системе и компьютере"

unit p1_u1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  BaseUnix;

type

  { TAboutForm }

  TAboutForm = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Cpu: TLabel;
    Label3: TLabel;
    OS: TLabel;
    Mem: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private

  public
        procedure GetOSInfo;
        procedure GetCpuInfo; // Добавили процедуру сбора данных о CPU
        procedure GetMemInfo;
        procedure InitializeCaptions;

  end;

var
  AboutForm: TAboutForm;

implementation

{$R *.lfm}

procedure TAboutForm.FormCreate(Sender: TObject);
begin
     InitializeCaptions;
end;

procedure TAboutForm.Button1Click(Sender: TObject);
begin
     AboutForm.Close;
end;

procedure TAboutForm.GetOSInfo;
var
  UNameRec: utsname; // Структура для информации о системе
  DistroName, DistroVersion: string;
  List: TStringList;
begin
  // 1. Получаем информацию о ядре через системный вызов
  FillChar(UNameRec, SizeOf(UNameRec), 0);
  fpUname(UNameRec);

  // 2. Пытаемся узнать название дистрибутива из /etc/os-release
  DistroName := 'Linux'; // Значение по умолчанию
  DistroVersion := '';

  if FileExists('/etc/os-release') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/etc/os-release');

      // Ищем ID (например, ubuntu) и PRETTY_NAME (например, Ubuntu 22.04.3 LTS)
      DistroName := List.Values['ID']; // Может вернуть 'ubuntu', 'debian' и т.д.
      if List.Values['PRETTY_NAME'] <> '' then
        DistroName := List.Values['PRETTY_NAME'];
    finally
      List.Free;
    end;
  end;

  // 3. Формируем строку
  // Пример результата: "Ubuntu 22.04.3 LTS (Kernel 5.15.0-76-generic)"
  if DistroName <> 'Linux' then
    OS.Caption := Format('%s (Kernel %s)', [DistroName, UNameRec.release])
  else
    OS.Caption := Format('Linux Kernel %s', [UNameRec.release]);
end;

procedure TAboutForm.GetMemInfo;
var
  List: TStringList;
  sLine, sVal: string;
  P: Integer;
  MemKB: QWord;
begin
  Mem.Caption := 'Unknown';

  // В Linux информация о памяти находится в файле /proc/meminfo
  if FileExists('/proc/meminfo') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/proc/meminfo');

      // Ищем строку, начинающуюся с MemTotal:
      // Формат строки: MemTotal:       16384000 kB
      for sLine in List do
      begin
        if Pos('MemTotal:', sLine) > 0 then
        begin
          // Удаляем "MemTotal:"
          sVal := sLine;
          Delete(sVal, 1, 9);

          // Получаем первое число (оно может идти с пробелами)
          sVal := Trim(sVal);
          P := Pos(' ', sVal);
          if P > 0 then
            sVal := Copy(sVal, 1, P - 1);

          // Конвертируем и форматируем
          if TryStrToQWord(sVal, MemKB) then
            Mem.Caption := FormatFloat('#,###" KB"', MemKB);

          Break;
        end;
      end;
    finally
      List.Free;
    end;
  end;
end;

procedure TAboutForm.GetCpuInfo;
var
  List: TStringList;
  I: Integer;
  Line: string;
  CpuModel: string;
  CpuCores: string;
begin
  CpuModel := 'Unknown CPU';
  CpuCores := '0';

  if FileExists('/proc/cpuinfo') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/proc/cpuinfo');

      for I := 0 to List.Count - 1 do
      begin
        Line := List[I];

        // Ищем строку с моделью процессора
        if Pos('model name', Line) = 1 then
        begin
          CpuModel := Copy(Line, Pos(':', Line) + 1, MaxInt);
          CpuModel := Trim(CpuModel); // Убираем лишние пробелы
        end;

        // Ищем количество ядер процессора
        if Pos('cpu cores', Line) = 1 then
        begin
          CpuCores := Copy(Line, Pos(':', Line) + 1, MaxInt);
          CpuCores := Trim(CpuCores);
        end;

        // Если нашли оба значения, выходим из цикла раньше
        if (CpuModel <> 'Unknown CPU') and (CpuCores <> '0') then
          Break;
      end;
    finally
      List.Free;
    end;
  end;

  // Формируем итоговую строку. Если данные не нашлись, выведется "Unknown CPU"
  if (CpuModel <> 'Unknown CPU') and (CpuCores <> '0') then
    Cpu.Caption := Format('%s (%s cores)', [CpuModel, CpuCores])
  else
    Cpu.Caption := 'Unknown CPU';
end;

procedure TAboutForm.InitializeCaptions;
begin
  // Теперь здесь только чистый последовательный вызов модулей
  GetOSInfo;
  GetCpuInfo;
  GetMemInfo;
end;

end.

Пример кода на Lazarus 4.6, dglOpenGL, SDL2 под Debian 13 . Инициализация SDL2, dglOpenGL.

Программа реализует пример инициализации SDL2 для создания окна и обработки событий окна на изменения размеров окна, закрытия окна по нажатию клавиши ESC. Инициализация dglOpenGL.

Рисунок 1. Демонстрация работы программы. Вращающийся треугольник.

Код проекта:

program ogl_p4;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  sysutils,
  sdl2lib,
  dglOpenGL;
const
  WINDOW_WIDTH  = 800;
  WINDOW_HEIGHT = 600;

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

procedure InitSystem;
begin
     // Загружаем SDL2 library из системных путей Debian 13 напрямую
     if Not SDL2LIB_Initialize(SDL_LibName) then
     begin
       raise Exception.Create('Не удалось динамически загрузить libSDL2.so через SDL2LIB_Initialize');
     end;

  // Инициализируем видеосистему SDL2
  if SDL_Init( SDL_INIT_VIDEO ) < 0 then
  begin
    WriteLn('Ошибка инициализации SDL2: ', SDL_GetError());
    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);
  SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 24);

  // Создаем окно через SDL2
  Window := SDL_CreateWindow(
    'SDL2 + dglOpenGL + Lazarus (Debian 13)',
    SDL_WINDOWPOS_CENTERED, SDL_WINDOWPOS_CENTERED,
    WINDOW_WIDTH, WINDOW_HEIGHT,
    SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN
    or SDL_WINDOW_RESIZABLE
  );

  if Window = nil then
    raise Exception.Create('Не удалось создать окно SDL2');

  // Создаем контекст OpenGL
  GLContext := SDL_GL_CreateContext(Window);
  if GLContext = nil then
    raise Exception.Create('Не удалось создать контекст OpenGL');

  // Загружаем внутренние указатели OpenGL (dglOpenGL подхватит контекст SDL2)
  if not InitOpenGL then
    raise Exception.Create('Не удалось инициализировать dglOpenGL через контекст SDL2');

  // Читаем расширения
  ReadExtensions;
  // Строку ReadImplementationProperties; лучше убрать, в некоторых версиях dglOpenGL под Linux она падает
  ReadImplementationProperties;

  // Базовая настройка сцены (Матрицы и проекция)
  glViewport(0, 0, WINDOW_WIDTH, WINDOW_HEIGHT);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, WINDOW_WIDTH / WINDOW_HEIGHT, 0.1, 100.0);
  glMatrixMode(GL_MODELVIEW);
  glClearColor(0.1, 0.1, 0.15, 1.0);
end;

procedure HandleResize(Width, Height: Integer);
begin
  // Защита от деления на ноль, если окно свернули
  if Height = 0 then Height := 1;

  // Обновляем область вывода OpenGL на весь экран окна
  glViewport(0, 0, Width, Height);

  // Переключаемся на матрицу проекции для ее обновления
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();

  // Задаем перспективную или ортогональную проекцию
  // Пример для Перспективы (3D): fov = 45 градусов, ближний отсекатель = 0.1, дальний = 100.0
  gluPerspective(45.0, Width / Height, 0.1, 100.0);

  // Возвращаем матрицу модели для обычного рендеринга объектов
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
end;

procedure HandleEvents;
begin
  // Обрабатываем очередь сообщений SDL2
  while SDL_PollEvent(@Event) <> 0 do
  begin
    case Event.type_ of
      // Событие закрытия окна
      SDL_QUITEV:
        Running := False;
      SDL_WINDOWEVENT:
      begin
           // Проверяем конкретный подтип события
          case Event.window.event of
            SDL_WINDOWEVENT_RESIZED,SDL_WINDOWEVENT_SIZE_CHANGED:
            begin
              // Извлекаем новые параметры ширины и высоты из события
              // и обновляем матрицы
              HandleResize(Event.window.data1, Event.window.data2);
            end;
          end;
      end;
      SDL_KEYDOWN:
        begin
          if Event.key.keysym.sym = SDLK_ESCAPE then
            Running := False;
        end;
    end;
  end;
end;

procedure UpdateFrame;
begin
  RotateAngle := RotateAngle + 0.5;
  if RotateAngle >= 360.0 then
    RotateAngle := RotateAngle - 360.0;
end;

procedure RenderFrame;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity();

  // Отодвигаем камеру назад на 3 единицы по оси Z (объект окажется перед камерой)
  glTranslatef(0.0, 0.0, -3.0);

  glRotatef(RotateAngle, 0.0, 0.0, 1.0);

  // Рисуем простой треугольник
  glBegin(GL_TRIANGLES);
    glColor3f(1.0, 0.0, 0.0); glVertex2f(0.0, 1.0);
    glColor3f(0.0, 1.0, 0.0); glVertex2f(-1.0, -1.0);
    glColor3f(0.0, 0.0, 1.0); glVertex2f(1.0, -1.0);
  glEnd();

  SDL_GL_SwapWindow(Window);
end;

procedure CleanUp;
begin
  if GLContext <> nil then
    SDL_GL_DeleteContext(GLContext);

  if Window <> nil then
    SDL_DestroyWindow(Window);

  SDL_Quit();
end;

begin
  try
    InitSystem;

    // Главный цикл программы
    while Running do
    begin
      HandleEvents;
      UpdateFrame;
      RenderFrame;
      SDL_Delay(16);
    end;

  except
    on E: Exception do
      Writeln('Ошибка: ', E.Message);
  end;

  CleanUp;
end.

 

Как удалить pdf24 с удаленного компьютера в локальной сети при помощи PsExec

Нашёл способ удаления программы pdf24 на удалённом компьютере в локальной сети. Команду удаления на удалённом компьютере будем запускать при помощи программы PsExec.exe. Если инсталлятор pdf24 создан на базе msi пакета, то удаление проводится при помощи программы MsiExec.exe, которая присутствует по-умолчанию в Windows 10 x64. Если инсталлятор pdf24 создан в виде exe пакета, то удаление сводится к запуска специального деинсталлятора unins000.exe, который находися в папке, куда установлена программа pdf24, по-умолчанию это путь (C:\Program Files\PDF24\unins000.exe). Сразу скажу, что на удаленном компьютере вы должны быть администратором, то есть ваша учётная запись должна находится в группе Администраторы.

Если установщик pdf24 создан в виде msi пакета, то чтобы удалить pdf24 нам нужно узнать идентификатор продукта msi (product_guid) pdf24. Идентифактор продукта msi для pdf24 можно посмотреть в реестре Windows 10. На всех компьютерах, где был установлен msi пакет pdf24 версии 11.23.0 будет GUID {092211C0-0A7B-4D36-A70D-C6DD8236533E}. В реестре его можно посмотреть по следующему пути:

Компьютер\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{092211C0-0A7B-4D36-A70D-C6DD8236533E}

В этой ветке найдите параметр UninstallString и там будет значение MsiExec.exe /I{092211C0-0A7B-4D36-A70D-C6DD8236533E}.

Взяв этот GUID сформируем команду удаления этого продукта с компьютера: "MsiExec.exe" /x {092211C0-0A7B-4D36-A70D-C6DD8236533E} /qn /norestart

/x – параметр удаления продукта

{092211C0-0A7B-4D36-A70D-C6DD8236533E} – GUID продукта для pdf24 версии 11.23.0

/qn – не выводить диалоги (окна) выбора ответа на вопрос (тихий режим удаления).

/norestart – не перезагружаем компьютер, если требуется.

Теперь применим эту команду удаления для pdf 24 на удалённый компьютер в локальной сети.

PsExec.exe \\pc01 -i -s -h -accepteula -nobanner "MsiExec.exe" /x {092211C0-0A7B-4D36-A70D-C6DD8236533E} /qn /norestart

\\pc01 – имя удалённого компьютера

i – интерактивный режим, позволяет взаимодействовать с текущей сессией рабочего стола пользователя.

s – права запуска учётной записи SYSTEM

h – запуск процесса с повышенными правами

accepteula - принимаем лицензионное соглашение, чтобы всплывающего окна не появилось

nobanner – скроем окно о правах

В том случае, если инсталлятор pdf24 в виде exe пакета, то команда удаления на локальном компьютере будет выглядить так: "C:\Program Files\PDF24\unins000.exe" /VERYSILENT /SUPPRESSMSGBOXES /NORESTART

/VERYSILENT – скрываем окно удаления и всё, что сним свзязано

/SUPPRESSMSGBOXES – закрываем все всплывающие сообщение в процессе удаления

/NORESTART - не перезагружаем компьютер, если требуется.

Теперь посмотрим команду удаления pdf24 программы в виде exe пакета на удалённом компьютере: PsExec.exe \\pc01 -i -h -accepteula -nobanner "C:\Program Files (x86)\PDF24\unins000.exe" /VERYSILENT /SUPPRESSMSGBOXES /NORESTART

На этом все. Данные команды работают. Сам проверил.