Реализация сферического шейдера BGRA с возможностью загрузки и вращения изображения в Pascal

Delphi , Графика и Игры , OpenGL

В этой статье мы рассмотрим, как создать эффект сферического отображения (Sphere Map) с использованием библиотеки BGRA в Pascal (Delphi/Lazarus). Этот эффект позволяет накладывать текстуру на сферу и вращать её в реальном времени с высокой частотой кадров.

Введение в сферическое отображение

Сферическое отображение (Sphere Mapping) - это техника текстурирования, при которой 2D-изображение проецируется на поверхность сферы. Это популярный метод в компьютерной графике для создания реалистичных отражений или планетарных текстур.

Настройка проекта

Для реализации нам понадобится: - Lazarus или Delphi - Установленный пакет BGRABitmap и BGRAOpenGL

Создадим новый проект и добавим следующие компоненты на форму: - TBGLVirtualScreen - для отображения OpenGL-графики - Три TFloatSpinEdit для управления вращением по осям X, Y, Z - Еще один TFloatSpinEdit для управления масштабом - TMemo для шейдерного кода - TTimer для анимации

Основной код реализации

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  Spin, BGRAOpenGL, BGRABitmapTypes, BGRAOpenGL3D, BGLVirtualScreen;

type
  { TForm1 }
  TForm1 = class(TForm)
    x_rot: TFloatSpinEdit;
    ShaderScreen1: TBGLVirtualScreen;
    FragMemo: TMemo;
    Timer1: TTimer;
    VertexMemo: TMemo;
    y_rot: TFloatSpinEdit;
    z_rot: TFloatSpinEdit;
    zoom: TFloatSpinEdit;
    procedure ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
    procedure ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
    procedure ShaderScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure InitShader;  // init and start shader
   private
   public
       gl_surface : IBGLTexture; 
       shader3 : TBGLShader3D;
       ctx  : TBGLContext;
       fshader : string; 
       vshader : string; // fragment and vertex
  end;

var
  Form1: TForm1;
  tt : Single;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  fshader := FragMemo.text;
  vshader := VertexMemo.Text;
end;

procedure TForm1.ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
begin
  if gl_surface <> nil then
    BGLContext.Canvas.StretchPutImage(0, 0, ShaderScreen1.Width, ShaderScreen1.Height, gl_surface);
  if shader3 <> nil then
  begin
    BGLContext.Canvas.Lighting.ActiveShader := shader3;
  end;
end;

procedure TForm1.ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
begin
  try
    gl_surface := BGLTexture(ResourceFile('gl.png')); // загружаем изображение (128x128, 256x256 или 512x512)

    // Создаем шейдер
    shader3 := TBGLShader3D.Create(
      BGLContext.Canvas,
      vshader,   // Вершинный шейдер
      fshader,   // Фрагментный шейдер
      'varying vec2 texCoord;',
      '130');    // Версия GLSL

    ctx := BGLContext;
    initShader;   // Запускаем шейдер
  except
    on E: Exception do
      raise exception.Create('Ошибка шейдера: ' + E.Message);
  end;
end;

procedure Tform1.InitShader;
begin
  try
    fshader := FragMemo.Text;
    vshader := VertexMemo.Text;

    if Assigned(shader3) then
    begin
      ctx.Canvas.Lighting.ActiveShader := nil;
      FreeAndNil(shader3);
    end;

    shader3 := TBGLShader3D.Create(ctx.Canvas, vshader, fshader, 'varying vec2 texCoord;', '130');

    Timer1.Enabled := True; // запускаем таймер
  except
    on E: Exception do
      ShowMessage('Ошибка шейдера: ' + E.Message);
  end;
end;

procedure TForm1.ShaderScreen1UnloadTextures(Sender: TObject;
  BGLContext: TBGLContext);
begin
  gl_surface  := nil;
  FreeAndNil(shader3);
  BGLContext.Canvas.Lighting.ActiveShader := nil;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if shader3 <> nil then
  begin
    shader3.UniformPointF['resolution'].Value := Pointf(Round(ShaderScreen1.Width),Round(ShaderScreen1.Height));
    shader3.UniformSingle['x_rot'].Value := x_rot.Value;
    shader3.UniformSingle['y_rot'].Value := y_rot.Value;
    shader3.UniformSingle['z_rot'].Value := z_rot.Value;
    shader3.UniformSingle['zoom'].Value := zoom.Value;
    shader3.UniformSingle['tm'].Value := tt;
    tt := tt + 0.02;
    ShaderScreen1.Invalidate;
  end;
end;

end.

Шейдерный код

Для работы эффекта нам понадобятся вершинный и фрагментный шейдеры. Вот пример фрагментного шейдера для сферического отображения:

uniform vec2 resolution;
uniform float x_rot;
uniform float y_rot;
uniform float z_rot;
uniform float zoom;
uniform float tm;
uniform sampler2D surface;

mat2 rot(float a) {
    float c=cos(a),s=sin(a);
    return mat2(c,s,-s,c);
}

void main() {
    vec2 uv = (gl_FragCoord.xy-0.5*resolution.xy)/resolution.y;
    uv *= zoom;

    // Вращение
    uv *= rot(x_rot);
    uv.y *= rot(y_rot);
    uv *= rot(z_rot);

    // Сферическое отображение
    vec3 col = vec3(0.0);
    float r = dot(uv,uv);
    if(r < 1.0) {
        uv *= inversesqrt(1.0-r);
        col = texture2D(surface,0.5*(uv.xy+1.0)).rgb;
    }

    gl_FragColor = vec4(col,1.0);
}

Расширение функционала

Как показано в исходном примере, мы можем расширить функционал, добавив выбор различных примитивов (сфера, куб, цилиндр и т.д.). Для этого нужно добавить дополнительный параметр в шейдер:

// В форме добавляем новый SpinEdit для выбора примитива
shape_num: TFloatSpinEdit;

// В обработчике таймера добавляем передачу параметра
shader3.UniformSingle['sn'].Value := shape_num.Value;

И модифицируем фрагментный шейдер:

uniform float sn; // номер примитива

float sdSphere(vec3 p, float s) {
    return length(p)-s;
}

float sdBox(vec3 p, vec3 b) {
    vec3 q = abs(p) - b;
    return length(max(q,0.0)) + min(max(q.x,max(q.y,q.z)),0.0);
}

float map(vec3 p) {
    if(sn == 0.0) return sdSphere(p, 0.5);
    if(sn == 1.0) return sdBox(p, vec3(0.3));
    // Добавьте другие примитивы по необходимости
    return sdSphere(p, 0.5);
}

Оптимизация работы с текстурами

Для улучшения качества отображения рекомендуется использовать текстуры с размерами, кратными степеням двойки (128x128, 256x256, 512x512). Если вас не устраивает качество стандартных изображений Lazarus, как упомянуто в обсуждении, вы можете:

1. Создать свои собственные изображения высокого разрешения (1024x1024 и более)
2. Использовать ресурсы из открытых источников
3. Генерировать текстуры программно с помощью BGRABitmap

Заключение

В этой статье мы рассмотрели реализацию сферического шейдера в Pascal с использованием библиотеки BGRA. Этот подход позволяет: - Загружать и отображать текстуры на сфере - Управлять вращением и масштабированием в реальном времени - Легко расширять функционал для работы с различными примитивами

Данная техника может быть использована для создания визуализаций планет, сферических отражателей или других графических эффектов в приложениях Delphi и Lazarus.

Создано по материалам из источника по ссылке.

Реализация сферического шейдера BGRA в Pascal с возможностью загрузки изображения и управления его вращением для создания эффекта сферического отображения.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: OpenGL ::