Android-приложения в Lazarus

[Alex2013]

На Snapdragon-е (Quest-3s) красивее .

https://youtu.be/hdOmqhATKIY
(Это уже тест на реальном устройстве под управлением ОС Андроид )
Неплохо, но скорость все равно не очень радует, так что нужно будет пробовать сделать "OpenGL версию".

[Seenkao]

Исправленные версии процедур и функций ...

можешь дальше исправлять и получить выхлоп в этих местах в два а то и более раза.
Почитать можешь здесь, при чём всю тему. Полезное пишут.

[Alex2013]

Исправленные версии процедур и функций ...

можешь дальше исправлять и получить выхлоп в этих местах в два а то и более раза.
Почитать можешь здесь, при чём всю тему. Полезное пишут.

1. Разумеется, я прекрасно понимаю, что причина выравнивания в оптимизации, но текущий код я пока вообще не оптимизировал (возможно, об этом позаботились его изначальные авторы (основу брал в примере из Hiasm, хотя, возможно, что это была далеко не первая его реализация), но сейчас я особо снова в этот код не вникал), к тому же вычисления с плавающей точкой требуют оптимизаций, отличных от целочисленных ухищрений.
2. Основной текущей задачей было, наоборот, избавиться от оптимизации и, получив чистый массив данных, загрузить его как шаблон «фоновой текстуры» в как бы по идее универсальный «волновой процессор».
3. Немного сомневаюсь, что в случае зоопарка реализаций ARM-платформ в принципе возможна стабильная «железячная оптимизация».
Зы.
За ссылку, разумеется, спасибо! Начал читать (с ходу такой объем информации не переварить, но попробую разобраться).
Зы. Зы.
Цель текущего проекта — самостоятельно воспроизвести на мобильной платформе что-то, что значительно отличается от стандартных примеров, и то, что может стать для меня неким «розеттским камнем» в деле переноса наработок из «мира виндовс» в «мир мобильных платформ».
(Вначале думал просто переписать, например, какой-нибудь «Терис с Дельфи» (или, например, всё тот же многострадальный «Дум»), но быстро понял, переписать что-то подобное будет, с одной стороны, черезчур простой задачей, а с другой — есть шанс погрязнуть в тонкостях реализации конкретной игры, не имеющих отношения к освоению программирования под андроид.) Так что пока как-то так.

Следующий этап развития проекта — в использовании «живого фона», получаемого с камеры мобильного устройства.

Зы Зы Зы
Как в LAMW правильно собирать "релизный APK" ?( все скрипты из примеров перепробовал работает только сборка "дебаг" версий APK, а они одна сплошная "дыра в системе" (требуют всех разрешений ОС держат открытыми проты отладки и т.п. )

[Seenkao]

Tools -> [LAMW] Android Module Wizard -> Build Released Signed...

А вообще, создавая новый проект, он вроде без отладки идёт.

[Alex2013]

Tools -> [LAMW] Android Module Wizard -> Build Released Signed...

А вообще, создавая новый проект, он вроде без отладки идёт.

У меня работает только laz4android 2.0.12...

...создавая новый проект, он вроде без отладки идёт.

Идет то может быть без отладки но apk собирает только такие...
ХХХХХ-debug.apk и ХХХХХ-debug-unaligned.apk

Tools -> [LAMW] Android Module Wizard -> Build Released Signed...

Упс! Действительно есть такое. Спасибо! Попробую

[Seenkao]

У меня работает только laz4android 2.0.12...

Я уже кидал тебе ссылку. Дополнительно в файле androidwidget найди строчку (функцию) procedure TAndroidWidget.SetBounds(NewLeft, NewTop, NewWidth, NewHeight: integer); и замени её код:

Код: Выделить всё

procedure TAndroidWidget.SetBounds(NewLeft, NewTop, NewWidth, NewHeight: integer);
begin
     // 18/06/2026: Lazarus 4.x up bug fix
	 // In Lazarus 4.0 and above, if we add a component by double clicking, 
	 // it doesn't appear because it has a width=0, height=0 size.	 
     if (csDesigning in ComponentState) then
     begin
          if NewWidth=0 then NewWidth:=100;
          if NewHeight=0 then NewHeight:=40;
     end; 
  if (Left=NewLeft) and (Top=NewTop) and (Width=NewWidth) and (Height=NewHeight) then Exit;
  FLeft:=NewLeft;
  FTop:=NewTop;
  FWidth:=NewWidth;
  FHeight:=NewHeight;
  if (csDesigning in ComponentState) then
    if Assigned(Parent) then
      Parent.Invalidate
end;

[Alex2013]

Я уже кидал тебе ссылку. Дополнительно в файле androidwidget найди строчку (функцию) procedure TAndroidWidget.SetBounds(NewLeft, NewTop, NewWidth, NewHeight: integer); и замени её код:

Спасибо я попробовал но что-то у меня пошло сильно не так ( пришлось откатываться к архивной копии впрочем возможно это жара так повлияла ( пару раз успел заметить заметил что монитор ресурсов показывал резкий разгон и скачек температуры встроенной видеокарты (читай ядра CPU) выше 100 градусов после чего система разумеется моментально влетала в перегрузку ( похоже эмулятор кривой))

[Alex2013]

Запустил программу на реальном смартфоне...
1. Нужно обязательно отключать все лишение «требования разрешений» (иначе антивирус входит «в режим паники»).
2. «Сборка релиза» не работает и портит проект (APK вообще перестает собираться даже в дебуг-версии (спасает только восстановление всего проекта из бэкапа, восстановление одних лазарус-исходников проекта ничем не поможет)).
3. В интерфейсе моей программы загадочным образом пропали все кнопки (тут это некритично, можно использовать клик по картинке, но что я сделал не так — непонятно (в эмуляторе и на QUEST3S всё Ок)).
4. Огромный заголовок окна определенно действует на нервы (как убрать — не нашел, стандартные LCL-приемы не помогают).
5. Тормозит почти так же, как на эмуляторе.
Зы
https://youtu.be/RpKPGT-y9Fc
Зы Зы
(фокус с procedure TAndroidWidget.SetBounds непременно попробую, спасибо и извиняюсь за отпечатки! )

[Seenkao]

Если ты про LAMW, то версия сама по себе глючная. Там в настройках, например, кнопок надо включать всякие свойства, чтоб они правильно отображались. Это что-то вроде свойства wrapcontent. Чтоб это понять, надо смотреть в java как это всё сделано. Ведь именно посредством java всё реализовано, а не посредством FPC/Lazarus.

[Seenkao]

5. Тормозит почти так же, как на эмуляторе.

код есть? Может по ZenGL попробую запустить и посмотреть результат?

[Alex2013]

1 "LAMW, то версия сама по себе глючная" совершенно согласен но это пока единственная среда для программирования под ОС Андроид с которой я хоть как-то поладил ( сборка по методу предложенному в ZenGL явно перспективнее но у меня просто не хватило терпения пройти все шаги правильно, а поскольку я пока в реалиях андроида практический "не в зуб ногой" разбираться приходится с тем что хоть как-то работает)

2 Что касается исходного кода то его не жалко просто смысла публиковать его нет. Основной модуль "рендера волн" сейчас почти универсальный так что если есть желание повозиться и перенести на свою платформу то я бы посоветовал начать с простой и понятной "тестовой виндовс адаптации " (главное там костылей заметно поменьше будет хотя код все равно явно тестовый и слегка "неухоженный" ) . WinWaveDemo2.7z ( "волновой процессор"(модуль WaveEffectsBin.pas) в этой версии уже "заточен под андроид" но отлаживать его проще вначале было под виндовс (но думаю что при желании можно и под линукс( если винды под рукой нет), без особых проблемы собрать) )
Версия исправленная и конкретно ее (в виде "релиза" с кодом ) я вроде не выкладывал
У меня работает так.
https://youtu.be/oGD4FpbRmn8

Всякий пожарный "боевая" версия WaveEffectsBin (на прямую из текущей андроид версии )
( если что-то и менял от исключительно по мелочи, но пусть будет... "береженого Ада Лавлейс бережет" )

Код: Выделить всё

unit WaveEffectsBin;

{$mode delphi}
{$POINTERMATH ON}

interface

uses
  Classes, SysUtils,Graphics, Math;

type
  // Структура для хранения состояния волн
  TWaveState = record
    Height: Single;
    Speed: Single;
  end;
  TWaveStateArray= array of TWaveState;

// ☆☆☆ УНИВЕРСАЛЬНАЯ ПРОЦЕДУРА РАБОТЫ С МАССИВОМ ПИКСЕЛЕЙ ☆☆☆
procedure WaveProcessorFXBin(
  Pixels: PByte;              // указатель на данные пикселей (RGBA)
  Width, Height: Integer;     // размеры изображения
  var Waves:TWaveStateArray;  // массив волн
  GridSize: Integer;          // размер сетки
  X, Y: Integer;              // -1 = только симуляция
  Radius: Integer;            // 0 = только симуляция
  HeightWave: Single;         // 0 = только симуляция
  Viscosity, WavesSpeed, LightIntensity, Depth: Single;
  Background: PByte = nil;    // указатель на фон (nil = градиент)
  BgWidth: Integer = 0; BgHeight: Integer = 0  // размеры фона
);

// Вспомогательные функции
procedure InitWaves(var Waves: TWaveStateArray; GridSize: Integer);
procedure ClearWaves(var Waves:TWaveStateArray; GridSize: Integer);
procedure GenerateGradient(Pixels: PByte; Width, Height: Integer);
procedure InitWavesRandom(var Waves: TWaveStateArray; GridSize: Integer; Amplitude: Single);

implementation

// ☆☆☆ ИНИЦИАЛИЗАЦИЯ ВОЛН (СЛУЧАЙНЫЕ ВОЗМУЩЕНИЯ) ☆☆☆
procedure InitWavesRandom(var Waves: TWaveStateArray; GridSize: Integer; Amplitude: Single);
var
  i: Integer;
begin
  for i := 0 to GridSize * GridSize - 1 do
  begin
    // Случайные возмущения с плавным переходом на границах
    Waves[i].Height := (Random - 0.5) * Amplitude * 2;
    Waves[i].Speed := (Random - 0.5) * Amplitude * 0.1;
  end;

  // Границы затухают
  for i := 0 to GridSize - 1 do
  begin
    Waves[i].Height := Waves[i].Height * 0.5;
    Waves[i].Speed := Waves[i].Speed * 0.5;

    Waves[(GridSize - 1) * GridSize + i].Height :=
      Waves[(GridSize - 1) * GridSize + i].Height * 0.5;
    Waves[(GridSize - 1) * GridSize + i].Speed :=
      Waves[(GridSize - 1) * GridSize + i].Speed * 0.5;

    Waves[i * GridSize].Height := Waves[i * GridSize].Height * 0.5;
    Waves[i * GridSize].Speed := Waves[i * GridSize].Speed * 0.5;

    Waves[i * GridSize + GridSize - 1].Height :=
      Waves[i * GridSize + GridSize - 1].Height * 0.5;
    Waves[i * GridSize + GridSize - 1].Speed :=
      Waves[i * GridSize + GridSize - 1].Speed * 0.5;
  end;
end;

// ☆☆☆ СОЗДАНИЕ ГРАДИЕНТА ☆☆☆
procedure GenerateGradient(Pixels: PByte; Width, Height: Integer);
var
  X, Y: Integer;
  idx: Integer;
  R, G, B: Byte;
  RowPtr: PByte;
begin
  if Pixels = nil then Exit;
  
  for Y := 0 to Height - 1 do
  begin
    RowPtr := Pixels + Y * Width * 4;
    for X := 0 to Width - 1 do
    begin
      idx := X * 4;
      
      B := Round(30 + 40 * (Y / Height));
      G := Round(80 + 100 * (Y / Height));
      R := Round(180 + 55 * (1 - (Y / Height)));
      
      RowPtr[idx] := 255;      // Alpha
      RowPtr[idx + 1] := R;    // Red
      RowPtr[idx + 2] := G;    // Green
      RowPtr[idx + 3] := B;    // Blue
    end;
  end;
end;

// ☆☆☆ ИНИЦИАЛИЗАЦИЯ ВОЛН ☆☆☆
procedure InitWaves(var Waves: TWaveStateArray; GridSize: Integer);
var
  i: Integer;
begin
  for i := 0 to GridSize * GridSize - 1 do
  begin
    Waves[i].Height := 0;
    Waves[i].Speed := 1;
  end;
end;

procedure ClearWaves(var Waves:TWaveStateArray; GridSize: Integer);
begin
  InitWaves(Waves, GridSize);
end;

// ☆☆☆ СОЗДАНИЕ ВОЛНЫ ☆☆☆
procedure MakeRipple(var Waves: array of TWaveState; GridSize: Integer;
  CX, CY, Radius: Integer; HeightWave: Single);
var
  X, Y, DX, DY, Dist, RadiusSq: Integer;
  Profile: Single;
  idx: Integer;
begin
  if GridSize < 1 then Exit;
  if (CX < 0) or (CY < 0) or (CX >= GridSize) or (CY >= GridSize) then Exit;
  
  RadiusSq := Radius * Radius;
  
  for X := Max(0, CX - Radius) to Min(GridSize - 1, CX + Radius) do
  begin
    DX := X - CX;
    for Y := Max(0, CY - Radius) to Min(GridSize - 1, CY + Radius) do
    begin
      DY := Y - CY;
      Dist := DX * DX + DY * DY;
      if Dist <= RadiusSq then
      begin
        Profile := 1.0 - Sqrt(Dist) / Radius;
        Profile := Profile * Profile * (3.0 - 2.0 * Profile);
        idx := Y * GridSize + X;
        Waves[idx].Height := Waves[idx].Height + HeightWave * Profile;
      end;
    end;
  end;
end;

// ☆☆☆ СИМУЛЯЦИЯ ВОЛН ☆☆☆
procedure SimulateWaves(var Waves: array of TWaveState; GridSize: Integer;
  Viscosity, WavesSpeed: Single);
var
  X, Y, idx: Integer;
  Ddx, Ddy, Viscosity1: Single;
begin
  if GridSize < 3 then Exit;
  if Length(Waves) < GridSize * GridSize then Exit;
  
  Viscosity1 := 1.0 - Viscosity;
  
  // Обновляем скорости
  for Y := 1 to GridSize - 2 do
    for X := 1 to GridSize - 2 do
    begin
      idx := Y * GridSize + X;
      Ddx := (Waves[idx + 1].Height - Waves[idx].Height) -
             (Waves[idx].Height - Waves[idx - 1].Height);
      Ddy := (Waves[idx + GridSize].Height - Waves[idx].Height) -
             (Waves[idx].Height - Waves[idx - GridSize].Height);
      Waves[idx].Speed := Waves[idx].Speed + (Ddx + Ddy) / WavesSpeed;
    end;
  
  // Обновляем высоты
  for Y := 1 to GridSize - 2 do
    for X := 1 to GridSize - 2 do
    begin
      idx := Y * GridSize + X;
      Waves[idx].Height := (Waves[idx].Height + Waves[idx].Speed) * Viscosity1;
    end;
  
  // Границы (затухание)
  for X := 1 to GridSize - 2 do
  begin
    Waves[X].Height := Waves[GridSize + X].Height * 0.95;
    Waves[(GridSize - 1) * GridSize + X].Height := 
      Waves[(GridSize - 2) * GridSize + X].Height * 0.95;
  end;
  
  for Y := 1 to GridSize - 2 do
  begin
    Waves[Y * GridSize].Height := Waves[Y * GridSize + 1].Height * 0.95;
    Waves[Y * GridSize + GridSize - 1].Height := 
      Waves[Y * GridSize + GridSize - 2].Height * 0.95;
  end;
end;

// ☆☆☆ РЕНДЕРИНГ ВОЛН В МАССИВ ПИКСЕЛЕЙ ☆☆☆
procedure RenderWavesToPixels(
  var Waves: array of TWaveState;
  GridSize: Integer;
  Pixels: PByte;
  Width, Height: Integer;
  Background: PByte;
  BgWidth, BgHeight: Integer;
  LightIntensity, Depth: Single);
var
  X, Y: Integer;
  GridX, GridY: Integer;
  Dx, Dy, HeightFactor, WaveHeight: Single;
  Light: Integer;
  XMap, YMap: Integer;
  R, G, B: Integer;
  idx, bgIdx: Integer;
  RowPtr, BgRowPtr: PByte;
  BgX, BgY: Integer;
begin
  if Pixels = nil then Exit;
  
  for Y := 0 to Height - 1 do
  begin
    RowPtr := Pixels + Y * Width * 4;
    
    for X := 0 to Width - 1 do
    begin
      // Преобразуем координаты пикселя в координаты сетки
      GridX := (X * GridSize) div Width;
      GridY := (Y * GridSize) div Height;
      
      if GridX >= GridSize then GridX := GridSize - 1;
      if GridY >= GridSize then GridY := GridSize - 1;
      
      idx := GridY * GridSize + GridX;
      WaveHeight := Waves[idx].Height;
      
      // Вычисляем наклон
      if GridX + 1 < GridSize then
        Dx := Waves[GridY * GridSize + GridX + 1].Height - WaveHeight
      else
        Dx := 0;
        
      if GridY + 1 < GridSize then
        Dy := Waves[(GridY + 1) * GridSize + GridX].Height - WaveHeight
      else
        Dy := 0;
      
      // Фактор глубины (искажение)
      HeightFactor := WaveHeight + Depth;
      if HeightFactor < 1.0 then HeightFactor := 1.0;
      
      // Смещение пикселя (эффект преломления)
      XMap := X + Round(Dx * HeightFactor * 0.5);
      YMap := Y + Round(Dy * HeightFactor * 0.5);
      
      if XMap < 0 then XMap := 0;
      if XMap >= Width then XMap := Width - 1;
      if YMap < 0 then YMap := 0;
      if YMap >= Height then YMap := Height - 1;
      
      // Вычисляем освещение
      Light := Round((Dx + Dy) * LightIntensity * 0.5);
      Light := Max(-128, Min(127, Light));
      
      // Добавляем блик на высоких волнах
      if Abs(WaveHeight) > 3.0 then
        Light := Light + Round(Abs(WaveHeight)) * 2;
      
      // Получаем пиксель из фона
      if Background <> nil then
      begin
        // Если фон другого размера — масштабируем координаты
        if (BgWidth > 0) and (BgHeight > 0) then
        begin
          BgX := (XMap * BgWidth) div Width;
          BgY := (YMap * BgHeight) div Height;
          if BgX >= BgWidth then BgX := BgWidth - 1;
          if BgY >= BgHeight then BgY := BgHeight - 1;
          BgRowPtr := Background + (BgY * BgWidth + BgX) * 4;
        end
        else
        begin
          BgRowPtr := Background + (YMap * Width + XMap) * 4;
        end;
        
        R := BgRowPtr[1] + Light;
        G := BgRowPtr[2] + Light;
        B := BgRowPtr[3] + Light;
      end
      else
      begin
        // Если фона нет — рисуем волны на чёрном
        R := 100 + Light;
        G := 150 + Light;
        B := 255 + Light;
      end;
      
      R := Max(0, Min(255, R));
      G := Max(0, Min(255, G));
      B := Max(0, Min(255, B));
      
      // Записываем результат
      idx := X * 4;
      if Background <> nil then
        RowPtr[idx] := BgRowPtr[0]  // Alpha из фона
      else
        RowPtr[idx] := 255;          // Alpha = 255
      
      RowPtr[idx + 1] := R;
      RowPtr[idx + 2] := G;
      RowPtr[idx + 3] := B;
    end;
  end;
end;

// ☆☆☆ ГЛАВНАЯ УНИВЕРСАЛЬНАЯ ПРОЦЕДУРА ☆☆☆
procedure WaveProcessorFXBin(
  Pixels: PByte;
  Width, Height: Integer;
  var Waves:TWaveStateArray;
  GridSize: Integer;
  X, Y: Integer;
  Radius: Integer;
  HeightWave: Single;
  Viscosity, WavesSpeed, LightIntensity, Depth: Single;
  Background: PByte = nil;
  BgWidth: Integer = 0; BgHeight: Integer = 0);
var
  NeedFreeBackground: Boolean;
  GradientPixels: array of Byte;
begin
  if Pixels = nil then Exit;
  if GridSize <= 0 then GridSize := 40;
  
  // Проверяем и инициализируем массив волн
  if Length(Waves) <> GridSize * GridSize then
    SetLength(Waves, GridSize * GridSize);
  
  // Инициализация волн при первом вызове
  if Waves[0].Height = 0 then
    InitWaves(Waves, GridSize);
  
  NeedFreeBackground := False;
  
  // Если фона нет — создаём градиент
  if Background = nil then
  begin
    SetLength(GradientPixels, Width * Height * 4);
    GenerateGradient(@GradientPixels[0], Width, Height);
    Background := @GradientPixels[0];
    BgWidth := Width;
    BgHeight := Height;
    NeedFreeBackground := True;
  end;
  
  // Если заданы координаты — создаём волну
  if (X >= 0) and (Y >= 0) and (Radius > 0) and (HeightWave > 0) then
    MakeRipple(Waves, GridSize, X, Y, Radius, HeightWave);
  
  // Симуляция физики волн
  SimulateWaves(Waves, GridSize, Viscosity, WavesSpeed);
  
  // Рендеринг в пиксели
  RenderWavesToPixels(
    Waves, GridSize,
    Pixels, Width, Height,
    Background, BgWidth, BgHeight,
    LightIntensity, Depth
  );
  
  // Освобождаем временный градиент
  if NeedFreeBackground then
    SetLength(GradientPixels, 0);
end;

end.

[Alex2013]

Слегка доработал (исправил вычисление "стартовой точки" для запуска волны )

https://youtu.be/p4jZ4ilSzdQ
Суть прикола в том что если использовать jImageView1.Width и jImageView1.Height
или даже Self.Height и Self.Height возникает "трагическое непонимание" а fWidth и fHeight работают нормально.
(Хотя по идее к ним вообще доступа быть не должно это-же внутренние поля класса jForm из секции protected ).

Код: Выделить всё

{-------------------------------------}
Const MB:Boolean=false;
  Xo: Integer=-10;
  Yo: Integer=-10;

procedure TAndroidModule1.jImageView1TouchDown(Sender: TObject; Touch: TMouch);
var
   X,Y,X1, Y1: Integer;
  Radius: Integer;
  Height: Single;
begin
  if not FIsRunning then exit;
X:=Trunc(Touch.Pt.X); Y:=Trunc(Touch.Pt.Y);
  If mb and ( Sqrt(Sqr(X-Xo)+Sqr(y-Yo)) >3 ) then begin
   Xo:=X;   Yo:=Y;
  end;
mb:=True;
X1:= Trunc(( X*FGridSize )/fWidth);
Y1:= Trunc(( Y*FGridSize )/fHeight);
Radius := 5 + Random(15);
Height := FRandomIntensity * (0.5 + Random * 0.5);
 MakeRippleAt(X1, Y1, 10, 12.0);
end;

procedure TAndroidModule1.jImageView1TouchMove(Sender: TObject; Touch: TMouch);
var
   X,Y: Integer;
begin
X:=Trunc(Touch.Pt.X); Y:=Trunc(Touch.Pt.Y);
  If mb and ( Sqrt(Sqr(X-Xo)+Sqr(y-Yo)) >3 ) then begin
    jImageView1TouchDown(Sender, Touch);
  end;
end;

procedure TAndroidModule1.jImageView1TouchUp(Sender: TObject; Touch: TMouch);
begin
   if mb then mb:=False;
end;

[Seenkao]

Посмотрел твой код. Основная проблема производительности, это постоянная конвертация BGR2RGBA и RGBA2BGR. Если ты избавишься от этой конвертации, то производительность повысится. И, если на Android ты используешь ту же конвертацию, то это очень сильно скажется там.

На Linux твой код не работает правильно, если изначальную картинку мне удалось сделать нормальной, то при создании волн картинка ломается всегда. Проблема в том, что на Linux формат pf24bit - всегда 24-х битный и прозрачности там ни какой нет. И вся функциональность которая основана на прозрачности должна быть переделана (что я и сделал), но картинка всё равно "ломается". А искать проблему мне лень...

[Alex2013]

"Постоянная конвертация BGR2RGBA и RGBA2BGR" артефакты отладки андроид версии "волнового процессора ".
(в андроиде похоже вообще почти нет других форматов кроме RGBA )
В исходной версии ничего подобного нет
Рабочая демка WaveDemo(Виндовс версия) с исходниками (на google drive)

[Alex2013]

OpenGL точнее OpenGLES версия "волнового процессора"
( Демку еще до конца не пересобрал но код модуля наконец хотя-бы компилируется )

WaveEffectsGL.pas

Код: Выделить всё

unit WaveEffectsGL;

{$mode delphi}
{$POINTERMATH ON}

interface

uses
  Classes, SysUtils, AndroidWidget, Laz_And_Controls,
  Laz_And_GLESv2_Canvas, Laz_And_GLESv2_Canvas_h, And_jni, Math;

type
  TGLWaveRenderer = class
  private
    FCanvas: jCanvasES2;
    FBackgroundTexture: GLuint;
    FProgramID: GLuint;  // Храним ID программы отдельно
    
    FWidth, FHeight: Integer;
    FTime: Single;
    FMouseX, FMouseY: Single;
    FMouseDown: Boolean;
    
    FViscosity: Single;
    FWavesSpeed: Single;
    FDepth: Single;
    
    FHasBackground: Boolean;
    FIsInitialized: Boolean;
    
    // Uniform locations
    FUniformTime: GLint;
    FUniformResolution: GLint;
    FUniformMouse: GLint;
    FUniformBackground: GLint;
    
    procedure LoadBackgroundTexture(Bitmap: jBitmap);
    procedure SetupShaderUniforms;
    
  public
    constructor Create(ACanvas: jCanvasES2);
    destructor Destroy; override;
    
    procedure Initialize(Width, Height: Integer);
    procedure Resize(Width, Height: Integer);
    procedure Render;
    procedure SetBackground(Bitmap: jBitmap);
    procedure SetMouse(X, Y: Single; Down: Boolean);
    procedure MakeRipple(X, Y: Single; Radius, Height: Single);
    procedure Update(DeltaTime: Single);
    procedure Clear;
    
    property Viscosity: Single read FViscosity write FViscosity;
    property WavesSpeed: Single read FWavesSpeed write FWavesSpeed;
    property Depth: Single read FDepth write FDepth;
    property IsInitialized: Boolean read FIsInitialized;
    property Time: Single read FTime;
  end;

implementation

const
  // Вершинный шейдер
  VERTEX_SHADER_SOURCE: String =
    'attribute vec2 aPosition;' +
    'attribute vec2 aTexCoord;' +
    'varying vec2 vTexCoord;' +
    'void main() {' +
    '  gl_Position = vec4(aPosition, 0.0, 1.0);' +
    '  vTexCoord = aTexCoord;' +
    '}';

  // Фрагментный шейдер с эффектом волн
  FRAGMENT_SHADER_SOURCE: String =
    'precision highp float;' +
    '' +
    'varying vec2 vTexCoord;' +
    'uniform vec2 uResolution;' +
    'uniform float uTime;' +
    'uniform vec2 uMouse;' +
    'uniform sampler2D uBackground;' +
    '' +
    '// Функция хеширования' +
    'float hash(vec2 p) {' +
    '  return fract(sin(dot(p, vec2(127.1, 311.7))) * 43758.5453);' +
    '}' +
    '' +
    '// Генерация волн' +
    'float wave(vec2 p, float time) {' +
    '  vec2 id = floor(p);' +
    '  vec2 f = fract(p);' +
    '  f = f * f * (3.0 - 2.0 * f);' +
    '' +
    '  float h1 = hash(id);' +
    '  float h2 = hash(id + vec2(1.0, 0.0));' +
    '  float h3 = hash(id + vec2(0.0, 1.0));' +
    '  float h4 = hash(id + vec2(1.0, 1.0));' +
    '' +
    '  float w1 = sin(time * 2.0 + h1 * 6.28) * 0.5 + 0.5;' +
    '  float w2 = sin(time * 2.0 + h2 * 6.28) * 0.5 + 0.5;' +
    '  float w3 = sin(time * 2.0 + h3 * 6.28) * 0.5 + 0.5;' +
    '  float w4 = sin(time * 2.0 + h4 * 6.28) * 0.5 + 0.5;' +
    '' +
    '  float h = mix(mix(w1, w2, f.x), mix(w3, w4, f.x), f.y);' +
    '  return h * 2.0 - 1.0;' +
    '}' +
    '' +
    '// Волна от касания' +
    'float ripple(vec2 p, vec2 center, float radius, float time) {' +
    '  float d = length(p - center);' +
    '  if (d > radius) return 0.0;' +
    '  float r = d / radius;' +
    '  float wave = sin(r * 30.0 - time * 5.0) * exp(-r * 3.0);' +
    '  return wave * (1.0 - r) * 2.0;' +
    '}' +
    '' +
    'void main() {' +
    '  vec2 uv = vTexCoord;' +
    '' +
    '  // Масштабируем координаты для волн' +
    '  vec2 wavePos = uv * 20.0;' +
    '' +
    '  // Основные волны' +
    '  float h1 = wave(wavePos + vec2(uTime * 0.1, 0.0), uTime);' +
    '  float h2 = wave(wavePos * 0.7 + vec2(0.0, uTime * 0.08), uTime * 0.8);' +
    '  float h = (h1 * 0.6 + h2 * 0.4) * 0.5;' +
    '' +
    '  // Волна от касания' +
    '  if (uMouse.x > 0.0 && uMouse.y > 0.0) {' +
    '    vec2 mousePos = uMouse;' +
    '    float rippleWave = ripple(uv, mousePos, 0.3, uTime);' +
    '    h += rippleWave * 0.5;' +
    '  }' +
    '' +
    '  // Эффект преломления' +
    '  vec2 refract = vec2(0.0);' +
    '  float hDepth = 1.0 / (h * 50.0 + 1.0);' +
    '  refract.x = (wave(wavePos + vec2(0.05, 0.0), uTime) - h) * 0.02;' +
    '  refract.y = (wave(wavePos + vec2(0.0, 0.05), uTime) - h) * 0.02;' +
    '' +
    '  vec2 texCoord = uv + refract * hDepth;' +
    '  texCoord = clamp(texCoord, 0.0, 1.0);' +
    '' +
    '  // Получаем цвет фона' +
    '  vec4 color = texture2D(uBackground, texCoord);' +
    '' +
    '  // Освещение' +
    '  float light = 0.5 + (h * 2.0);' +
    '  light = clamp(light, 0.0, 2.0);' +
    '' +
    '  // Блик' +
    '  float specular = pow(max(0.0, h), 4.0) * 0.5;' +
    '' +
    '  color.rgb *= light;' +
    '  color.rgb += specular;' +
    '' +
    '  gl_FragColor = color;' +
    '}';

{ TGLWaveRenderer }

constructor TGLWaveRenderer.Create(ACanvas: jCanvasES2);
begin
  inherited Create;
  FCanvas := ACanvas;
  FViscosity := 0.02;
  FWavesSpeed := 4.0;
  FDepth := 50.0;
  FTime := 0.0;
  FMouseX := -1;
  FMouseY := -1;
  FMouseDown := False;
  FHasBackground := False;
  FIsInitialized := False;
  FBackgroundTexture := 0;
  FProgramID := 0;
  FUniformTime := -1;
  FUniformResolution := -1;
  FUniformMouse := -1;
  FUniformBackground := -1;
end;

destructor TGLWaveRenderer.Destroy;
begin
  Clear;
  inherited;
end;

procedure TGLWaveRenderer.Clear;
begin
  if FBackgroundTexture <> 0 then
  begin
    _glTexture_Free(FBackgroundTexture);
    FBackgroundTexture := 0;
  end;
  FIsInitialized := False;
  FProgramID := 0;
end;

procedure TGLWaveRenderer.SetupShaderUniforms;
begin
  if FProgramID = 0 then Exit;
  
  // Получаем locations для uniform'ов
  FUniformTime := glGetUniformLocation(FProgramID, 'uTime');
  FUniformResolution := glGetUniformLocation(FProgramID, 'uResolution');
  FUniformMouse := glGetUniformLocation(FProgramID, 'uMouse');
  FUniformBackground := glGetUniformLocation(FProgramID, 'uBackground');
end;

procedure TGLWaveRenderer.LoadBackgroundTexture(Bitmap: jBitmap);
var
  P: PScanByte;
  Width, Height: Integer;
begin
  if Bitmap = nil then Exit;
  
  Width := Bitmap.Width;
  Height := Bitmap.Height;
  
  // Освобождаем старую текстуру
  if FBackgroundTexture <> 0 then
  begin
    _glTexture_Free(FBackgroundTexture);
    FBackgroundTexture := 0;
  end;
  
  // Создаем новую текстуру
  glGenTextures(1, @FBackgroundTexture);
  glBindTexture(GL_TEXTURE_2D, FBackgroundTexture);
  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);
  
  Bitmap.LockPixels(P);
  try
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Width, Height, 0, 
      GL_RGBA, GL_UNSIGNED_BYTE, P);
  finally
    Bitmap.UnlockPixels;
  end;
  
  FHasBackground := True;
end;

procedure TGLWaveRenderer.Initialize(Width, Height: Integer);
begin
  if FCanvas = nil then Exit;
  
  FWidth := Width;
  FHeight := Height;
  
  try
    // Компилируем шейдеры
    if not FCanvas.Shader_Compile(VERTEX_SHADER_SOURCE, FRAGMENT_SHADER_SOURCE) then
      raise Exception.Create('Shader compile failed');
    
    if not FCanvas.Shader_Link then
      raise Exception.Create('Shader link failed');
    
    // Получаем ID программы через glGetIntegerv
    glGetIntegerv(GL_CURRENT_PROGRAM, @FProgramID);
    
    if FProgramID = 0 then
      raise Exception.Create('Failed to get program ID');
    
    // Устанавливаем шейдер
    FCanvas.Shader := Shader_Texture;
    
    // Получаем uniform locations
    SetupShaderUniforms;
    
    // Настраиваем экран
    FCanvas.Screen_Setup(Width, Height, xp2D, False);
    FCanvas.Screen_Clear(0.1, 0.2, 0.3, 1.0);
    
    // Создаем пустую текстуру для фона
    if FBackgroundTexture = 0 then
    begin
      glGenTextures(1, @FBackgroundTexture);
      glBindTexture(GL_TEXTURE_2D, FBackgroundTexture);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Width, Height, 0, 
        GL_RGBA, GL_UNSIGNED_BYTE, nil);
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
    end;
    
    FIsInitialized := True;
  except
    on E: Exception do
    begin
      FIsInitialized := False;
      FProgramID := 0;
      raise;
    end;
  end;
end;

procedure TGLWaveRenderer.Resize(Width, Height: Integer);
begin
  if FCanvas = nil then Exit;
  
  FWidth := Width;
  FHeight := Height;
  FCanvas.Screen_Setup(Width, Height, xp2D, False);
end;

procedure TGLWaveRenderer.Render;
var
  // Вершины квадрата [-1..1]
  Vertices: array[0..7] of GLfloat = (
    -1.0, -1.0,
     1.0, -1.0,
    -1.0,  1.0,
     1.0,  1.0
  );
  // Текстурные координаты
  TexCoords: array[0..7] of GLfloat = (
    0.0, 1.0,
    1.0, 1.0,
    0.0, 0.0,
    1.0, 0.0
  );
begin
  if (FCanvas = nil) or (not FIsInitialized) or (FProgramID = 0) then Exit;
  
  // Очищаем экран
  FCanvas.Screen_Clear(0.1, 0.2, 0.3, 1.0);
  
  // Используем программу
  glUseProgram(FProgramID);
  
  // Устанавливаем uniform'ы
  if FUniformResolution >= 0 then
    glUniform2f(FUniformResolution, FWidth, FHeight);
  
  if FUniformTime >= 0 then
    glUniform1f(FUniformTime, FTime);
  
  if FUniformMouse >= 0 then
    glUniform2f(FUniformMouse, FMouseX, FMouseY);
  
  // Привязываем текстуру
  glActiveTexture(GL_TEXTURE0);
  if FBackgroundTexture <> 0 then
    glBindTexture(GL_TEXTURE_2D, FBackgroundTexture)
  else
    glBindTexture(GL_TEXTURE_2D, 0);
  
  if FUniformBackground >= 0 then
    glUniform1i(FUniformBackground, 0);
  
  // Настраиваем атрибуты вершин
  glVertexAttribPointer(0, 2, GL_FLOAT, GL_FALSE, 0, @Vertices);
  glEnableVertexAttribArray(0);
  
  glVertexAttribPointer(1, 2, GL_FLOAT, GL_FALSE, 0, @TexCoords);
  glEnableVertexAttribArray(1);
  
  // Рисуем квадрат
  glDrawArrays(GL_TRIANGLE_STRIP, 0, 4);
  
  // Отключаем атрибуты
  glDisableVertexAttribArray(0);
  glDisableVertexAttribArray(1);
end;

procedure TGLWaveRenderer.SetBackground(Bitmap: jBitmap);
begin
  LoadBackgroundTexture(Bitmap);
end;

procedure TGLWaveRenderer.SetMouse(X, Y: Single; Down: Boolean);
begin
  if FWidth > 0 then
  begin
    FMouseX := X / FWidth;
    FMouseY := 1.0 - (Y / FHeight);
  end;
  FMouseDown := Down;
end;

procedure TGLWaveRenderer.MakeRipple(X, Y: Single; Radius, Height: Single);
begin
  if FWidth > 0 then
  begin
    FMouseX := X / FWidth;
    FMouseY := 1.0 - (Y / FHeight);
  end;
end;

procedure TGLWaveRenderer.Update(DeltaTime: Single);
begin
  FTime := FTime + DeltaTime;
end;

end.