понедельник, 13 октября 2025 г.

Минимальное 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
 

понедельник, 6 октября 2025 г.

Пример кода на Delphi и OpenGL. Переключение камеры, привязка камеры к объекту

Программа реализует пример переключения камеры между объектами, привязка камеры к объекту.

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

Код проекта:

unit ogl_p17_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dglOpenGL, ExtCtrls, Math, DGlut;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    h_RC: HGLRC; // Контекст рендеринга
    h_DC: HDC;   // Контекст устройства

    procedure AttachCameraToCube;
    procedure AttachCameraToCube2;
    procedure ReturnCameraToOrigPos;
    procedure InitGL;
    procedure DrawGLScene;
    procedure UpdateCamera;
    procedure HandleKeys;
    procedure DrawCube;
    procedure DrawCube2;
    procedure DrawTrack;
    procedure BuildFont;
    procedure glPrint(text: string);
    { Public declarations }
  end;

var
  Form1: TForm1;
   
  CubePos: array [0..2] of GLfloat = (0, 0, 0); // Позиция куба
  Cube2Pos: array [0..2] of GLfloat = (0, 0, 0); // Позиция куба 2
  Cube2PosCount: GLfloat = 1.0;
  Cube2Rot: GLfloat = 0.0;
  Cube2Speed: GLfloat = 1.0;
  CubeRot: GLfloat = 0.0; // Угол вращения куба
  CamPos: array [0..2] of GLfloat = (0, 5, 10); // Позиция камеры
  CamPitch: GLfloat; // Углы поворота камеры
  MoveSpeed: GLfloat = 0.1; // Скорость перемещения
  CamPosFlag: GLbyte;
  
const
  CAM_FREE = 0;
  CAM_CUBE1 = 1;
  CAM_CUBE2 = 2;
  FONT_BASE = 1000;

implementation

{$R *.dfm}

procedure TForm1.BuildFont;
var
  h_Font: HFONT;
begin
  h_Font := CreateFont(
    -16,
    0,
    0,
    0,
    FW_NORMAL,
    0,
    0,
    0,
    RUSSIAN_CHARSET,
    OUT_TT_PRECIS,
    CLIP_DEFAULT_PRECIS,
    ANTIALIASED_QUALITY,
    FF_DONTCARE or DEFAULT_PITCH,
    'Arial'                      
  );
  SelectObject(h_DC, h_Font);
  wglUseFontBitmaps(h_DC, 0, 256, FONT_BASE);
  DeleteObject(h_Font);
end;

procedure TForm1.glPrint(text: string);
begin
  glListBase(FONT_BASE);
  glCallLists(Length(text), GL_UNSIGNED_BYTE, PAnsiChar(AnsiString(text)));
end;

procedure TForm1.AttachCameraToCube;
begin
  CamPos[0] := CubePos[0] + 3;
  CamPos[1] := CubePos[1] + 4;
  CamPos[2] := CubePos[2] + 5;
end;

procedure TForm1.AttachCameraToCube2;
begin
  CamPos[0] := Cube2Pos[0] + 3;
  CamPos[1] := Cube2Pos[1] + 4;
  CamPos[2] := Cube2Pos[2] + 5;
end;

procedure TForm1.ReturnCameraToOrigPos;
begin
  CamPos[0] := 0;
  CamPos[1] := 5;
  CamPos[2] := 10;
end;

procedure TForm1.InitGL;
begin
  InitOpenGL;
  h_DC := GetDC(Handle);

  h_RC := CreateRenderingContext(h_DC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(h_DC, h_RC);

  if Assigned(wglSwapIntervalEXT) then
    wglSwapIntervalEXT(1);

  glClearColor(0.0, 0.0, 0.0, 1.0); // Чёрный фон
  glEnable(GL_DEPTH_TEST); // Включение теста глубины
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(45.0, 640/480, 0.1, 100.0); // Настройка перспективы
  glMatrixMode(GL_MODELVIEW);

  BuildFont;
end;

procedure TForm1.UpdateCamera;
begin
  glLoadIdentity;
  case CamPosFlag of
    CAM_FREE: // Исходная позиция
      gluLookAt(CamPos[0], CamPos[1], CamPos[2], 0, 0, 0, 0, 1, 0);
    CAM_CUBE1: // Следим за первым кубом
      gluLookAt(CamPos[0], CamPos[1], CamPos[2], CubePos[0], CubePos[1], CubePos[2], 0, 1, 0);
    CAM_CUBE2: // Следим за вторым кубом
      gluLookAt(CamPos[0], CamPos[1], CamPos[2], Cube2Pos[0], Cube2Pos[1], Cube2Pos[2], 0, 1, 0);
  end;
end;

procedure TForm1.HandleKeys;
var
  Angle: GLfloat;
begin
  if GetAsyncKeyState(VK_F1) < 0 then
  begin
    CamPosFlag := CAM_CUBE1;
    AttachCameraToCube;
  end;

  if GetAsyncKeyState(VK_F2) < 0 then
  begin
    CamPosFlag := CAM_CUBE2;
    AttachCameraToCube2;
  end;

  if GetAsyncKeyState(VK_F3) < 0 then
  begin
    CamPosFlag := CAM_FREE;
    ReturnCameraToOrigPos;
  end;

  if GetAsyncKeyState(VK_UP) < 0 then
  begin
    CubePos[2] := CubePos[2] - MoveSpeed;
    if CamPosFlag = CAM_CUBE1 then
      AttachCameraToCube;
  end;

  if GetAsyncKeyState(VK_DOWN) < 0 then
  begin
    CubePos[2] := CubePos[2] + MoveSpeed;
    if CamPosFlag = CAM_CUBE1 then
      AttachCameraToCube;
  end;

  if GetAsyncKeyState(VK_LEFT) < 0 then
  begin
    CubePos[0] := CubePos[0] - MoveSpeed;
    if CamPosFlag = CAM_CUBE1 then
      AttachCameraToCube;
  end;

  if GetAsyncKeyState(VK_RIGHT) < 0 then
  begin
    CubePos[0] := CubePos[0] + MoveSpeed;
    if CamPosFlag = CAM_CUBE1 then
      AttachCameraToCube;
  end;

  CubeRot := CubeRot + 2.0; // Вращение
  if CubeRot >= 360 then CubeRot := 0;

  // Движение и вращение второго куба
  Cube2PosCount := Cube2PosCount + Cube2Speed;
  if Cube2PosCount >= 360 then Cube2PosCount := 0;

  // Всегда обновляем позицию второго куба
  Angle := DegToRad(Cube2PosCount);
  Cube2Pos[0] := 5*Cos(Angle);
  Cube2Pos[1] := 0.5;
  Cube2Pos[2] := 5*Sin(Angle);

  
  Cube2Rot := Cube2Rot + 3.0; // Независимое вращение
  if Cube2Rot >= 360 then Cube2Rot := 0;
end;

procedure TForm1.DrawCube;
begin
  glColor3f(0, 0, 1); // Синий цвет
  glPushMatrix;
    glTranslatef(CubePos[0], CubePos[1], CubePos[2]);
    glRotatef(CubeRot, 0, 1, 0); // Вращение вокруг Y
    glutSolidCube(1.0); // Используем GLUT для простоты
  glPopMatrix;
end;

procedure TForm1.DrawCube2;
begin
  glColor3f(1, 0, 1); // Фиолетовый цвет
  glPushMatrix;
    glTranslatef(Cube2Pos[0], Cube2Pos[1], Cube2Pos[2]);
    glRotatef(Cube2Rot, 0, 1, 0);
    glutSolidCube(1.0);
  glPopMatrix;
end;

procedure TForm1.DrawTrack;
var
  i: Integer;
begin
  glColor3f(1, 1, 0); // Жёлтый цвет
  glBegin(GL_LINE_STRIP);
    for i := 0 to 360 do
      glVertex3f(5*Cos(DegToRad(i)), 0, 5*Sin(DegToRad(i)));
  glEnd;
end;

procedure TForm1.DrawGLScene;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;

  UpdateCamera;
  HandleKeys;
  DrawTrack;
  DrawCube;
  DrawCube2;

// Сохраняем текущую матрицу
  glPushMatrix;
  
  // Переключаемся в 2D режим для текста
  glMatrixMode(GL_PROJECTION);
  glPushMatrix;
  glLoadIdentity;
  gluOrtho2D(0, ClientWidth, ClientHeight, 0); // 2D проекция
  
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;
  
  // Отключаем тест глубины для текста
  glDisable(GL_DEPTH_TEST);
  
  // Устанавливаем цвет текста
  glColor3f(1.0, 1.0, 1.0); // Белый цвет
  
  // Рисуем текст
  glRasterPos2f(10, 20);
  glPrint('F1 - Синий куб');
  
  glRasterPos2f(10, 40);
  glPrint('F2 - Розовый куб');
  
  glRasterPos2f(10, 60);
  glPrint('F3 - Вся сцена');
  
  // Восстанавливаем настройки
  glEnable(GL_DEPTH_TEST);
  
  glPopMatrix; // MODELVIEW
  glMatrixMode(GL_PROJECTION);
  glPopMatrix; // PROJECTION
  glMatrixMode(GL_MODELVIEW);
  glPopMatrix; // исходная матрица

  SwapBuffers(h_DC);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  wglMakeCurrent(0, 0);
  wglDeleteContext(h_RC);
  ReleaseDC(Handle, h_DC);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := False; 
  InitGL;
  KeyPreview := True;
  Visible := True;
  tmr1.Interval := 16;
  CamPosFlag := 0;
  Cube2PosCount := 0;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(45.0, ClientWidth/ClientHeight, 0.1, 100.0);
  glMatrixMode(GL_MODELVIEW);
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  DrawGLScene;
end;

end.

Пример кода на Delphi и OpenGL. Три разных варианта пламени

Выкладываю три варианта пламени, визуальные эффекты получились прикольные.

1) Пламя зелёное

Рисунок 1. Пример работы программы зелёного пламени

Код проекта:

unit ogl_p9_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, dglOpenGL, Math;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure tmr1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FireTexture: GLuint;
    buffer: array[0..199, 0..319] of Word;
    h_DC: HDC;     // Хранение контекста устройства
    h_RC: HGLRC;   // Хранение контекста рендеринга
    procedure InitGL;
    procedure SetupViewport;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitGL; // Исправлено имя процедуры инициализации
  Randomize;
  FillChar(buffer, SizeOf(buffer), 0);
  tmr1.Interval := 50;
end;

procedure TForm1.InitGL;
begin
  // Инициализация OpenGL
  InitOpenGL; // Инициализация библиотеки
  h_DC := GetDC(Handle);
  
  // Создание контекста с правильными атрибутами
  h_RC := CreateRenderingContext(h_DC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(h_DC, h_RC);

  // Настройка параметров OpenGL
  glClearColor(0.0, 0.0, 0.0, 1.0); // Черный фон
  SetupViewport;

  // Создание текстуры с правильным форматом
  glGenTextures(1, @FireTexture);
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 320, 200, 0, 
               GL_RGB, GL_UNSIGNED_SHORT_5_6_5, nil); // Исправлен формат
end;

procedure TForm1.SetupViewport;
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluOrtho2D(0, 320, 200, 0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  x, y, xPrev, xNext: Integer;
  sum: Cardinal;
begin
  // Активация контекста перед использованием
  ActivateRenderingContext(h_DC, h_RC);

  // Генерация новых пикселей
  for x := 0 to 319 do
    buffer[199, x] := IfThen(Random(2) = 1, $F800, $0000);

  // Распространение пламени
  for y := 198 downto 0 do
    for x := 0 to 319 do
    begin
      xPrev := (x - 1 + 320) mod 320;
      xNext := (x + 1) mod 320;
      sum := buffer[y+1, xPrev] + buffer[y+1, x] + buffer[y+1, xNext];
      //buffer[y, x] := sum div 3;
      buffer[y, x] := (sum div 3) and $FFE0; // Уменьшаем интенсивность
    end;

  // Обновление текстуры
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, 320, 200, 
                 GL_RGB, GL_UNSIGNED_SHORT_5_6_5, @buffer[0][0]);

  // Отрисовка
  glClear(GL_COLOR_BUFFER_BIT);
  glEnable(GL_TEXTURE_2D);
  glBegin(GL_QUADS);
    glTexCoord2f(0, 0); glVertex2f(0, 0);
    glTexCoord2f(1, 0); glVertex2f(320, 0);
    glTexCoord2f(1, 1); glVertex2f(320, 200);
    glTexCoord2f(0, 1); glVertex2f(0, 200);
  glEnd;

  SwapBuffers(h_DC); // Используем сохраненный контекст
end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
   // Корректное удаление ресурсов
  glDeleteTextures(1, @FireTexture);
  wglMakeCurrent(0, 0);
  wglDeleteContext(h_RC);
  ReleaseDC(Handle, h_DC);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  ActivateRenderingContext(h_DC, h_RC); // Активируем контекст
  SetupViewport;
  Invalidate;
end;

end.

2) Пламя синие

Рисунок 2. Пример работы программы синего пламени

Код проекта:

unit ogl_p10_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, dglOpenGL, Math;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FireTexture: GLuint;
    FirePalette: array[0..255] of TRGBQuad;
    buffer: array[0..199, 0..319] of Byte;
    h_DC: HDC;
    h_RC: HGLRC;
    procedure InitGL;
    procedure SetupViewport;
    procedure GeneratePalette;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitGL;
  Randomize;
  FillChar(buffer, SizeOf(buffer), 0);
  GeneratePalette;
  tmr1.Interval := 50;
end;

procedure TForm1.GeneratePalette;
var
  i: Integer;
begin
  // Правильная огненная палитра (красный -> оранжевый -> желтый)
  for i := 0 to 255 do
  begin
    // Черное ядро пламени
    if i < 32 then
    begin
      FirePalette[i].rgbRed := i * 2;
      FirePalette[i].rgbGreen := 0;
      FirePalette[i].rgbBlue := 0;
    end
    // Красная зона
    else if i < 96 then
    begin
      FirePalette[i].rgbRed := 255;
      FirePalette[i].rgbGreen := (i - 32) * 4;
      FirePalette[i].rgbBlue := 0;
    end
    // Оранжевая зона
    else if i < 160 then
    begin
      FirePalette[i].rgbRed := 255;
      FirePalette[i].rgbGreen := 128 + (i - 96) * 2;
      FirePalette[i].rgbBlue := (i - 96) * 4;
    end
    // Желтое ядро
    else
    begin
      FirePalette[i].rgbRed := 255;
      FirePalette[i].rgbGreen := 255;
      FirePalette[i].rgbBlue := (i - 160) * 16;
    end;
  end;
end;

procedure TForm1.InitGL;
begin
  InitOpenGL;
  h_DC := GetDC(Handle);
  
  h_RC := CreateRenderingContext(h_DC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(h_DC, h_RC);

  glClearColor(0.0, 0.0, 0.0, 1.0);
  SetupViewport;

  glGenTextures(1, @FireTexture);
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  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, GL_RGBA, 320, 200, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
end;

procedure TForm1.SetupViewport;
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluOrtho2D(0, 320, 200, 0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  x, y, xPrev, xNext: Integer;
  sum: Integer;
  rgbBuffer: array[0..199, 0..319] of TRGBQuad;
begin
  // Генерация огня с большей интенсивностью
  for x := 0 to 319 do
    buffer[199, x] := 160 + Random(96);  // Старт с горячих цветов

  // Улучшенный алгоритм распространения
  for y := 198 downto 0 do
    for x := 0 to 319 do
    begin
      xPrev := (x - 1 + 320) mod 320;
      xNext := (x + 1) mod 320;

      sum := buffer[y+1, xPrev] + 
             buffer[y+1, x] * 2 + 
             buffer[y+1, xNext] + 
             buffer[y+2, x] + 
             Random(4);  // Добавляем шум

      //buffer[y, x] := Max(0, (sum div 5) - 1);
      buffer[y, x] := Max(0, (sum div 5) - (y div 70)); // Усиливаем затухание с высотой
    end;

  // Конвертация в RGB с коррекцией цвета
  for y := 0 to 199 do
    for x := 0 to 319 do
    begin
      // Применяем гамма-коррекцию
      rgbBuffer[y, x] := FirePalette[Min(255, buffer[y, x] * 2)];
      rgbBuffer[y, x].rgbBlue := rgbBuffer[y, x].rgbBlue div 4;  // Уменьшаем синий
    end;

  // Обновление текстуры
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, 320, 200, 
                 GL_RGBA, GL_UNSIGNED_BYTE, @rgbBuffer);

  // Рендеринг
  glClear(GL_COLOR_BUFFER_BIT);
  glEnable(GL_TEXTURE_2D);

  glBegin(GL_QUADS);
    glTexCoord2f(0, 0); glVertex2f(0, 0);
    glTexCoord2f(1, 0); glVertex2f(320, 0);
    glTexCoord2f(1, 1); glVertex2f(320, 200);
    glTexCoord2f(0, 1); glVertex2f(0, 200);
  glEnd;

  SwapBuffers(h_DC);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  glDeleteTextures(1, @FireTexture);
  wglMakeCurrent(0, 0);
  wglDeleteContext(h_RC);
  ReleaseDC(Handle, h_DC);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  ActivateRenderingContext(h_DC, h_RC);
  SetupViewport;
  Invalidate;
end;

end.

3) Пламя красное

Рисунок 3. Пример работы программы красного пламени 

 Код проекта:

unit ogl_p11_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, dglOpenGL, Math;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
    FireTexture: GLuint;
    FirePalette: array[0..255] of TRGBQuad;
    buffer: array[0..199, 0..319] of Byte;
    h_DC: HDC;
    h_RC: HGLRC;
    procedure InitGL;
    procedure SetupViewport;
    procedure GeneratePalette;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitGL;
  Randomize;
  FillChar(buffer, SizeOf(buffer), 0);
  GeneratePalette;
  tmr1.Interval := 50;
end;

procedure TForm1.GeneratePalette;
var
  i: Integer;
begin
  // Правильная огненная палитра (без синих оттенков)
  for i := 0 to 255 do
  begin
    case i of
      0..63:   // Черный -> Темно-красный
      begin
        FirePalette[i].rgbRed := i;
        FirePalette[i].rgbGreen := 0;
        FirePalette[i].rgbBlue := 0;
      end;
      64..127: // Красный -> Оранжевый
      begin
        FirePalette[i].rgbRed := 255;
        FirePalette[i].rgbGreen := (i - 64) * 2;
        FirePalette[i].rgbBlue := 0;
      end;
      128..191: // Оранжевый -> Желтый
      begin
        FirePalette[i].rgbRed := 255;
        FirePalette[i].rgbGreen := 128 + (i - 128);
        FirePalette[i].rgbBlue := 0;
      end;
      192..255: // Желтый -> Белый
      begin
        FirePalette[i].rgbRed := 255;
        FirePalette[i].rgbGreen := 255;
        FirePalette[i].rgbBlue := (i - 192) * 4;
      end;
    end;
  end;
end;

procedure TForm1.InitGL;
begin
  InitOpenGL;
  h_DC := GetDC(Handle);
  
  h_RC := CreateRenderingContext(h_DC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(h_DC, h_RC);

  glClearColor(0.0, 0.0, 0.0, 1.0);
  SetupViewport;

  glGenTextures(1, @FireTexture);
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  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, GL_RGBA8, 320, 200, 0, GL_BGRA, GL_UNSIGNED_BYTE, nil);
end;

procedure TForm1.SetupViewport;
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluOrtho2D(0, 320, 200, 0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  glDeleteTextures(1, @FireTexture);
  wglMakeCurrent(0, 0);
  wglDeleteContext(h_RC);
  ReleaseDC(Handle, h_DC);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  ActivateRenderingContext(h_DC, h_RC);
  SetupViewport;
  Invalidate;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  x, y, xPrev, xNext: Integer;
  sum: Integer;
  rgbBuffer: array[0..199, 0..319] of TRGBQuad;
begin
  // Генерация основания пламени с большей интенсивностью
  for x := 0 to 319 do
    buffer[199, x] := Min(255, 192 + Random(64));

  // Улучшенный алгоритм распространения пламени
  for y := 198 downto 0 do
    for x := 0 to 319 do
    begin
      xPrev := (x - 1 + 320) mod 320;
      xNext := (x + 1) mod 320;

      // Новое ядро пламени с турбулентностью
      sum := (buffer[y+1, xPrev] +
             buffer[y+1, x] * 2 +
             buffer[y+1, xNext] +
             buffer[y+2, x] * 2) div 6;

      // Добавляем случайные колебания
      buffer[y, x] := Max(0, sum - 1 + Random(3) - 1);
    end;

  // Конвертация в RGB
  for y := 0 to 199 do
    for x := 0 to 319 do
      rgbBuffer[y, x] := FirePalette[Min(255, buffer[y, x] + Random(8))];

  // Обновление текстуры
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, 320, 200,
                 GL_BGRA, GL_UNSIGNED_BYTE, @rgbBuffer);

  // Рендеринг
  glClear(GL_COLOR_BUFFER_BIT);
  glEnable(GL_TEXTURE_2D);
  glBegin(GL_QUADS);
    glTexCoord2f(0, 0); glVertex2f(0, 0);
    glTexCoord2f(1, 0); glVertex2f(320, 0);
    glTexCoord2f(1, 1); glVertex2f(320, 200);
    glTexCoord2f(0, 1); glVertex2f(0, 200);
  glEnd;

  SwapBuffers(h_DC);
end;

end.

Пример кода на Delphi и OpenGL. Вращение камеры, управление камерой.

Нашёл на форуме по программированию (Ссылка) частично не рабочий код, довёл его до работоспособности. Пример показывает вращение камеры и управление камерой с клавиатуры.

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

unit p1_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OpenGL, ExtCtrls;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    tmr2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure tmr2Timer(Sender: TObject);
  private
    { Private declarations }
    newCount, frameCount, lastCount : LongInt;
    fpsRate : GLfloat;

    procedure MyInitOpenGL(dc:HDC);
    procedure PaintGL(dc:HDC);
    procedure SetDCPixelFormat(DC:HDC);
    procedure SetLight;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hgc:HGLRC;
  tx,ty,tz:GLfloat;
  gox,goy,goz:GLfloat;
  buf:TBitmap;
  LightPos:array [0..3] of GLfloat=(-1.5,0.0,-3.0,1.0);
  LightAmb:array [0..3] of GLfloat=(0.5,0.5,0.5,1.0);
  LightDif:array [0..3] of GLfloat=(1.0,1.0,1.0,1.0);
  glFog_Color:array [0..3] of GLfloat=(0.5,0.5,0.5,1.0);
  
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

  // Инициализация переменных
  goz := -8;
  tx := 0; // Инициализация tx
  ty := 0; // Инициализация ty
  tz := 0; // Инициализация tz
  gox := 0; // Инициализация goX
  goy := 0; // Инициализация goY

  // Установка заголовка формы
  Form1.Caption := 'x=' + FloatToStr(tx) + '  y=' + FloatToStr(ty);

  // Инициализация OpenGL
  MyInitOpenGL(Canvas.Handle);
  PaintGL(Canvas.Handle);

  // Установка параметров OpenGL
  glViewport(0, 0, ClientWidth, ClientHeight);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_LIGHTING);
  glEnable(GL_LIGHT0);
  glEnable(GL_COLOR_MATERIAL);
  glEnable(GL_POLYGON_SMOOTH);
  
  // Установка матрицы проекции
  glMatrixMode(GL_PROJECTION);
  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
  glDepthFunc(GL_LEQUAL);
  
  // Возврат к матрице модели
  glMatrixMode(GL_MODELVIEW);

  // Запоминаем текущее время
  lastCount := GetTickCount;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

  if Key=VK_ESCAPE then Form1.Close;

  // Проверка нажатия клавиш без Shift
  if not (ssShift in Shift) then
  begin
    if Key = VK_UP then
      tx := tx + 1;
    if Key = VK_DOWN then
      tx := tx - 1;
    if Key = VK_LEFT then
      ty := ty - 1;
    if Key = VK_RIGHT then
      ty := ty + 1;
    if Key = VK_INSERT then
      tz := tz + 0.3;
    if Key = VK_DELETE then
      tz := tz - 0.3;
  end;

  // Проверка нажатия клавиш с Shift
  if ssShift in Shift then
  begin
    if Key = VK_UP then
      goz := goz + 0.3;
    if Key = VK_DOWN then
      goz := goz - 0.3;
    if Key = VK_LEFT then
      gox := gox - 0.3;
    if Key = VK_RIGHT then
      gox := gox + 0.3;
    if Key = VK_INSERT then
      goy := goy + 0.3;
    if Key = VK_DELETE then
      goy := goy - 0.3;
  end;

  // Проверка границ для tX и tY
  if tx = 361 then
    tx := 0;
  if tx = -1 then
    tx := 360;
  if ty = 361 then
    ty := 0;
  if ty = -1 then
    ty := 360;

  // Обновление окна
  InvalidateRect(Handle, nil, False);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // Проверяем, установлен ли контекст
  if hgc <> 0 then
  begin
    // Устанавливаем текущий контекст в 0 перед удалением
    wglMakeCurrent(0, 0);
    // Удаляем контекст
    wglDeleteContext(hgc);
    hgc := 0; // Обнуляем hgc после удаления
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  PaintGL(Canvas.Handle);
  newCount:=GetTickCount;
  Inc(frameCount);
  if newCount-lastCount>1000 then
  begin
    fpsRate:=frameCount;
    lastCount:=newCount;
    frameCount:=0;
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  // Убедитесь, что контекст OpenGL активен перед вызовом функций OpenGL
  glMatrixMode(GL_MODELVIEW);

  // Установите размер области просмотра
  glViewport(0, 0, ClientWidth, ClientHeight);

  // Сброс матрицы модели
  glLoadIdentity;

  // Если нужно, можно задать перспективу
  // glFrustum (-1, 1, -1, 1, 3, 10); // задаем перспективу

  // Перерисовка окна
  InvalidateRect(Handle, nil, False);
end;

procedure TForm1.myInitOpenGL(dc:HDC);
begin
  SetDCPixelFormat(dc);
  hgc:=wglCreateContext(dc);
  wglMakeCurrent(dc,hgc);
end;

procedure TForm1.PaintGL(dc: HDC);
begin

  glMatrixMode(GL_PROJECTION);
  glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, 1);
  glClearColor(0,0,0.7,1);

  glClear(GL_COLOR_BUFFER_BIT+GL_DEPTH_BUFFER_BIT);
  glColor3f(0,1,0);
  glLoadIdentity();

  SetLight;
  glBegin(GL_QUADS);
    glVertex3f(-1,-1,-1);
    glVertex3f(-1,1,-1);
    glVertex3f(1,1,-1);
    glVertex3f(1,-1,-1);
  glEnd();

  glBegin(GL_QUADS);
    glVertex3f(-1,-1,1);
    glVertex3f(-1,1,1);
    glVertex3f(1,1,1);
    glVertex3f(1,-1,1);
  glEnd();

  glBegin(GL_QUADS);
    glVertex3f(-1,1,-1);
    glVertex3f(-1,1,1);
    glVertex3f(-1,-1,1);
    glVertex3f(-1,-1,-1);
  glEnd();

  glColor4d(0.7,0,0,0.8);

  glBegin(GL_QUADS);
    glVertex3f(1,1,-1);
    glVertex3f(1,1,1);
    glVertex3f(1,-1,1);
    glVertex3f(1,-1,-1);
  glEnd();

  glColor4f(0,1,0,1.0);

  glBegin(GL_QUADS) ;
    glVertex3f(1,1,1);
    glVertex3f(1,1,-1);
    glVertex3f(-1,1,-1);
    glVertex3f(-1,1,1);
  glEnd();

  glBegin(GL_QUADS) ;
    glVertex3f(1,-1,1);
    glVertex3f(1,-1,-1);
    glVertex3f(-1,-1,-1);
    glVertex3f(-1,-1,1);
  glEnd();

  glColor3f(0,1,1);

  glBegin(GL_QUADS);
    glVertex3f(10,-1.1,10);
    glVertex3f(10,-1.1,-10);
    glVertex3f(-10,-1.1,-10);
    glVertex3f(-10,-1.1,10);
  glend;

  glColor3f(0,1,1);

  glMatrixMode(GL_MODELVIEW);

  glLoadIdentity();
  glTranslated(0,2,0);

  glLoadIdentity();
  gluPerspective(45, ClientWidth/ClientHeight, 0.1, 100);


  //glFrustum (-2, 2, -2, 2, 3, 100);    // задаем перспективу
  //glOrtho(-2,2,-2,2,3,10);

  glTranslatef(gox, goy, goz);       // перенос объекта по оси Z
  glRotatef(tx,1,0,0);
  glRotatef(ty,0,1,0);
  glRotatef(tz,0,0,1);

  glEnable(GL_FOG);
  glFogi(GL_FOG_MODE, GL_LINEAR);
  glFogiv(GL_FOG_COLOR, @glFog_COLOR);
  glFog(GL_FOG_DENSITY, 0.35);
  glFog(GL_FOG_HINT, GL_DONT_CARE);
  glFog(GL_FOG_START, 5.0);
  glFog(GL_FOG_END, -5.0);

  SwapBuffers(dc);

end;

procedure TForm1.SetDCPixelFormat(DC: HDC);
var
  nPixelFormat: Integer;
  pfd: PIXELFORMATDESCRIPTOR;
begin
  FillChar(pfd, SizeOf(pfd), 0);
  pfd.nSize := SizeOf(PIXELFORMATDESCRIPTOR); // Установка размера структуры
  pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_GDI or PFD_GENERIC_ACCELERATED or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
  pfd.cDepthBits := 32;

  nPixelFormat := ChoosePixelFormat(DC, @pfd);
  if nPixelFormat = 0 then
  begin
    // Обработка ошибки: не удалось выбрать формат пикселей
    Exit;
  end;

  if SetPixelFormat(DC, nPixelFormat, @pfd) = False then
  begin
    // Обработка ошибки: не удалось установить формат пикселей
    Exit;
  end;
end;

procedure TForm1.SetLight;
begin
  glDisable(GL_LIGHTING);
  glDisable(GL_LIGHT0);
  glLightfv(GL_LIGHT0, GL_AMBIENT, @LightAmb);
  glLightfv(GL_LIGHT0, GL_POSITION, @lightPos);
  glLightfv(GL_LIGHT0, GL_DIFFUSE, @lightDif);
  glEnable(GL_LIGHT0);
  glEnable(GL_LIGHTING);
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  Refresh;
  tmr1.Free;
end;

procedure TForm1.tmr2Timer(Sender: TObject);
begin
  Form1.Caption:='x='+FloatToStr(tx)+'  y='+FloatToStr(ty)+' z='+FloatToStr(tz)+' goX='+FloatToStr(gox)+' goY='+FloatToStr(goy)+'  goZ='+FloatToStr(goz)+' FPS='+FloatToStr(fpsRate);
  InvalidateRect(Handle, nil, False);
end;

end.

 

Пример кода на Delphi и OpenGL, показывающий интересный визуальный эффект

 

В Интернет нашёл код на Delphi + GDI (Ссылка), перевёл этот код на Delphi + OpenGL. Вышел интересный визуальный эффект. 

 

Рисунок 1. Результат работы программы

Код проекта:

unit ogl_p1_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OpenGL, ExtCtrls;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

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

  ARGB = array[0..0] of TRGB;
  PARGB = ^ARGB;

var
  Form1: TForm1;
  MyBmp: TBitmap;
  i: Byte = 0;
  hrc: HGLRC; // Контекст OpenGL
  FHDC: HDC;  // Контекст устройства

implementation

{$R *.dfm}

const
  pfd: TPixelFormatDescriptor = (
    nSize: SizeOf(TPixelFormatDescriptor);
    nVersion: 1;
    dwFlags: PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
    iPixelType: PFD_TYPE_RGBA;
    cColorBits: 24;
    cDepthBits: 16;
    iLayerType: PFD_MAIN_PLANE;
  );

procedure SetupOrthoProjection;
begin
  glViewport(0, 0, Form1.ClientWidth, Form1.ClientHeight);

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glOrtho(0, Form1.ClientWidth, 0, Form1.ClientHeight, -1, 1);

  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  glDisable(GL_DEPTH_TEST);
end;

procedure InitOpenGL;
begin
  // Настройка OpenGL
  glClearColor(0.0, 0.0, 0.0, 0.0);
  SetupOrthoProjection;
end;

procedure CreateOpenGLContext;
begin
  FHDC := GetDC(Form1.Handle); // Получаем контекст устройства
  if FHDC = 0 then
    raise Exception.Create('Не удалось получить контекст устройства.');

  // Устанавливаем формат пикселей
  if not SetPixelFormat(FHDC, ChoosePixelFormat(FHDC, @pfd), @pfd) then
    raise Exception.Create('Не удалось установить формат пикселей.');

  // Создаем контекст OpenGL
  hrc := wglCreateContext(FHDC);
  if hrc = 0 then
    raise Exception.Create('Не удалось создать контекст OpenGL.');

  // Активируем контекст OpenGL
  if not wglMakeCurrent(FHDC, hrc) then
    raise Exception.Create('Не удалось активировать контекст OpenGL.');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Задаем фиксированные размеры для Bitmap
  MyBmp := TBitmap.Create;
  MyBmp.PixelFormat := pf24bit;
  MyBmp.Width := Form1.ClientWidth; // Фиксированная ширина
  MyBmp.Height := Form1.ClientHeight; // Фиксированная высота

  // Настраиваем таймер
  tmr1.Interval := 50;
  tmr1.Enabled := True;

  CreateOpenGLContext;
  // Инициализация OpenGL
  InitOpenGL;
end;

procedure Draw;
var
  LinePointer: PARGB;
  a, b: Real;
  x, y: Integer;
  xPos, yPos: GLfloat;
begin
  // Заполняем Bitmap данными
  for y := 0 to (MyBmp.Height - 1) do
  begin
    LinePointer := MyBmp.ScanLine[y];
    for x := 0 to (MyBmp.Width - 1) do
    begin
      a := x * x + i;
      b := y * y + i;
      LinePointer[x].R := Trunc(Abs(b));
      LinePointer[x].G := Trunc(Abs(a + b));
      LinePointer[x].B := Trunc(Abs(a));
    end;
  end;

  // Очищаем буфер и отрисовываем Bitmap
  glClear(GL_COLOR_BUFFER_BIT);

  // Вычисляем позицию для центрирования
  xPos := Abs(Form1.ClientWidth - MyBmp.Width) div 2;
  yPos := Abs(Form1.ClientHeight - MyBmp.Height) div 2;

  //glRasterPos2f(-1, -1);
  glRasterPos2f(xPos, yPos);
  glDrawPixels(MyBmp.Width, MyBmp.Height, GL_RGB, GL_UNSIGNED_BYTE, LinePointer);
  SwapBuffers(FHDC); // Обмениваем буферы
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // Освобождаем ресурсы
  if Assigned(MyBmp) then
    MyBmp.Free;

  if hrc <> 0 then
  begin
    wglMakeCurrent(0, 0);
    wglDeleteContext(hrc);
  end;

  if FHDC <> 0 then
    ReleaseDC(Form1.Handle, FHDC);
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  Draw;
  Inc(i);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  if (Form1.ClientWidth < 640) or (Form1.ClientHeight < 480) then
  begin
      MyBmp.Width := Form1.ClientWidth; // Фиксированная ширина
      MyBmp.Height := Form1.ClientHeight; // Фиксированная высота
  end
  else
  begin
      MyBmp.Width := 640; // Фиксированная ширина
      MyBmp.Height := 480; // Фиксированная высота
  end;

  SetupOrthoProjection;
end;

end.