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

 

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

 

Минимальное OpenGL + SDL 2 приложение на языке Lisp (SBCL) под Windows 10

Я уже пытался освоить Lisp в этой статье (https://notidealrunner.blogspot.com/2013/01/common-lisp-fedora-17-kde.html). В конце статьи я сказал, что мы попробуем написать OpenGL программу на Lisp. Каким-то чудом это у меня получилось. Читаем ниже.

 

1. Установка диалекта Lisp (SBCL) на Windows 10

Для начала скачайте SBCL (Steel Bank Common Lisp) с официального сайта проекта по ссылке (https://www.sbcl.org/platform-table.html). На момент написания статьи на сайте доступна версия 2.5.9 Установка SBCL проста: следуйте инструкциям мастера установки. После установки путь до SBCL установится в переменную окружения PATH. Запустите командную строку и выполните команду sbcl --version. 

 

2. Установка менеджера пакетов Quicklisp

Скачайте quicklisp с официального сайта по ссылке (https://beta.quicklisp.org/quicklisp.lisp). Сохраните quicklisp.lisp, например, в папку c:\users\[ваш пользователь]\Downloads\. В командной строке выполните команду sbcl, после этого вы попадёте в командную строку sbcl. Для установки Quicklisp в C:\users\[ваш пользователь]\quicklisp и добавления его загрузку в инициализацию SBCL необходима выполнить следующие команды:

 

1) (load "c:/users/user/Downloads/quicklisp.lisp") — загрузит файл quicklisp.lisp

2) (quicklisp-quickstart:install) — установит менеджер пакетов

3) (ql:add-to-init-file) - добавит строку загрузки менеджера пакетов quicklisp в c:\users\[ваш пользователь]\.sbclrc 

 

3. Загрузка пакетов OpenGL и SDL 2

В SBCL для работы с OpenGL используют пакет cl-opengl для рисовки графики и для работы с SDL 2 используют пакет sdl2 для создания окна.

 

1) (ql:quickload "cl-opengl") – для OpenGL

2) (ql:quickload "sdl2") – для SDL 2

 

4. Пример кода на lisp с использованием OpenGL и SDL

 

(defpackage #:sdl2-opengl-triangle
  (:use :cl)
  (:export :run))

(in-package :sdl2-opengl-triangle)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '("sdl2" "cl-opengl")))

(defparameter *window-width* 640)
(defparameter *window-height* 480)

(defun run()
  (sdl2:with-init (:video)
    (sdl2:with-window (window :title "OpenGL Triangle"
                              :w *window-width*
                              :h *window-height*
                              :flags '(:opengl :shown))
	(let ((context (sdl2:gl-create-context window)))
        (unwind-protect
             (progn
               (sdl2:gl-make-current window context)
               (gl:viewport 0 0 *window-width* *window-height*)
               
               ;; Основной цикл рендеринга
               (sdl2:with-event-loop (:method :poll)
                 (:quit () t)
                 (:keydown (:keysym keysym)
                           (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-escape)
                             (sdl2:push-event :quit)))
                 (:idle ()
                        ;; Очистка буфера
                        (gl:clear-color 0.1 0.1 0.1 1.0)
                        (gl:clear :color-buffer-bit)
                        
                        ;; Рисуем треугольник
                        (gl:begin :triangles)
                        (gl:color 1.0 0.0 0.0)  ; красный
                        (gl:vertex -0.5 -0.5 0.0)
                        (gl:color 0.0 1.0 0.0)  ; зелёный
                        (gl:vertex  0.5 -0.5 0.0)
                        (gl:color 0.0 0.0 1.0)  ; синий
                        (gl:vertex  0.0  0.5 0.0)
                        (gl:end)
                        
                        ;; Показываем кадр
                        (sdl2:gl-swap-window window)
                        
                        ;; Ограничиваем FPS (~60)
                        (sdl2:delay 16)
				  )
				)
             ;; Освобождение контекста
             (sdl2:gl-delete-context context)
			 )
		)
	)
	)
  )
)

5. Скачать SDL2.dll  

Прежде чем загружать и запускать пример на Lisp c OpenGL и SDL, вам необходимо скачать последние драйвера для вашей видеокарты, это позволит вам запускать OpenGL приложения и динамическую библиотеку SDL 2 для запуска приложений SDL 2. Скачать SDL 2 можно с официального сайта (https://github.com/libsdl-org/SDL/releases/tag/release-2.30.11). Последняя версия SDL 2 это 2.30.11. Скопируйте SDL2.dll в папку, где у вас установлен SBCL, рядом с файлом sbcl.exe. У меня это папка C:\Program Files\Steel Bank Common Lisp\.

 

6. Команда загрузки примера кода на Lisp и его запуск 

(load "h:/Programming/Projects/lisp/lisp_opengl_p1/sdl-opengl.lisp")

(sdl2-opengl-triangle:run)

 

Рисунок 1. Пример работы программы на Lisp с использованием OpenGL и SDL 2