freepascal.ru

Вполне неожиданно: ИИ сделал некоторую ошибку и вместо того, что я его запрашивал сделал по факту wavplayer. Он оказался действующим. Я только переименовал несколько функций, чтобы он соответствовал назначению и развил его до вполне используемого состояния с помощью того же ИИ. Также интересным является расширенный файл заголовков alsa. https://codeberg.org/Alexander2024/wavplayer

Так сказать "ОНО НАЧАЛОСЬ !!" ( Правда толи радоваться толи огорчаться этому обстоятельству все еще не совсем ясно) Я тут для интереса и тренировки навыков "промт инжиниринга" пытаюсь получить с помощью LLM "эффект кругов на воде" радиальные волны с искажением картинки ВСЕ доступные мне модели как сговорились пишут код отрисовки цветных кругов в упор не понимая что такое "волны с искажением " Нашел скрипт RAD_WAVE.POC от автодеск-аниматора на его "встроенном Си" пытаюсь перевести( с помощью LLM) на паскаль, кое-что получается но это очень медленный способ ( когда-то точно был очень быстрый пример с рекурсией )

Кроме того есть такая крякозябра среди демок от HiAsm.


(в HiAsm-е есть такой модуль HIWaveProcessor но как водится там все довольно заморочено (LLM давятся хотя это код на честном паскале (компилируется FPC)))

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

unit hiWaveProcessor;

interface

uses Windows,Kol,Share,Debug;

type
  TWave = record
    height: double;
    speed : double;
  end;
  TByteArray = array[0..0] of byte;
  PByteArray = ^TByteArray;
  THIWaveProcessor = class(TDebug)
   private
    rep: string;
   
    bitmapWidth    : integer;
    bitmapHeight   : integer;
    backgroundLines: array of PByteArray;
    bitmapLines    : array of PByteArray;
    halfResolution : boolean;
   
    Image, bitmap: PBitmap;
   
    waves: array of array of TWave;
   
    lightIntensity: double; // Intensité de l'effet de lumière
    depth         : double; // Profondeur de l'eau pour la pseudo-réfraction
    viscosity     : double; // pseudo-viscosité pour l'animation
    wavesSpeed    : double; // paramêtre pour la vitesse des vagues (doit valoir au minimum 2.0)
   
    leftDown: boolean;
   
    lastT   : integer;
    fpsCount: integer;
   
    procedure init();
    procedure initWavesArray();
    procedure initWavesData();
    procedure initBackgroundLines();
    procedure initBitmapLines();

    procedure simul();
    procedure simulEdges();
    procedure ripple(centerX, centerY, radius: integer; height: double);   

    procedure render();
    procedure idle;
   public
    _prop_Viscosity:integer;
    _prop_Vitesse:integer;
    _prop_Luminosity:integer;
    _prop_Profondeur:integer;
    _prop_Radius:integer;
    _prop_Height:real;

    _data_Height:THI_Event;
    _data_Radius:THI_Event;
    _data_Y:THI_Event;
    _data_X:THI_Event;
    _data_Bitmap:THI_Event;
    _data_Image:THI_Event;
    _event_onProcess:THI_Event;

    procedure _work_doProcess(var _Data:TData; Index:word);
    procedure _work_doRipple(var _Data:TData; Index:word);
  end;

implementation

procedure THIWaveProcessor._work_doProcess;
var b,im:PBitmap;
begin
   im := ReadBitmap(_Data, _data_Image);
   b := ReadBitmap(_Data, _data_Bitmap);
   if image <> im then
     begin
       image := im;
       bitmap := b;
       init();
     end;
   initBackGroundLines();
   idle();
   _hi_onEvent(_event_onProcess);
end;

procedure THIWaveProcessor._work_doRipple;
var x,y,r:integer;
    h:real;
begin
   x := ReadInteger(_Data, _data_X);
   y := ReadInteger(_Data, _data_Y);
   r := ReadInteger(_Data, _data_Radius, _prop_Radius);
   h := ReadReal(_Data, _data_Height, _prop_Height);
   ripple(x,y,r,h);
end;

procedure THIWaveProcessor.idle;
begin
  simulEdges();
  simul();
  render();
end;

procedure THIWaveProcessor.init();
begin
  halfResolution := false;
  bitmapWidth  := image.width;
  bitmapHeight := image.height;

  lightIntensity := _prop_Luminosity;
  wavesSpeed     := _prop_Vitesse;
  viscosity      := _prop_Viscosity/100;
  depth          := _prop_Profondeur/10.0;

  initBitmapLines();
  initBackGroundLines();

  initWavesArray();
  initWavesData();
end;

procedure THIWaveProcessor.initWavesArray();
var
  x: integer;
begin
  setLength(waves, bitmapWidth+1);
  for x:=0 to bitmapWidth do
    setLength(waves[x], bitmapHeight+1);
end;

procedure THIWaveProcessor.initWavesData();
var
  x: integer;
  y: integer;
begin
  for x:=0 to bitmapWidth do
  for y:=0 to bitmapHeight do
   begin
     waves[x, y].height := 0.0;
     waves[x, y].speed := 0.0;
   end;
end;

procedure THIWaveProcessor.initBackgroundLines();
var
  i: integer;
begin
  Bitmap.PixelFormat := pf24bit;
  setLength(backgroundLines, bitmap.Height);
  for i:=0 to bitmap.Height-1 do
    backgroundLines[i] := Bitmap.ScanLine[i];
end;

procedure THIWaveProcessor.initBitmapLines();
var
  i: integer;
begin
  image.PixelFormat := pf24bit;
  setLength(bitmapLines, bitmapHeight);
  for i:=0 to bitmapHeight-1 do
    bitmapLines[i] := image.ScanLine[i];
end;

procedure THIWaveProcessor.simul();
var
  x: integer;
  y: integer;
  d1: double;
  d2: double;
  ddx: double;
  ddy: double;
  viscosity1: double;
begin
  for x:=1 to bitmapWidth-1 do
  for y:=1 to bitmapHeight-1 do
    begin
    // Formule du calcul:
    // accèlération de la hauteur = double dérivée de la hauteur au point concerné
    //
    // d²h     d²h   d²h          1
    // --- = ( --- + --- ) x ------------
    // dt²     dx²   dy²      wavesSpeed
    //
    // La dérivée de la hauteur représente la "pente" au point concerné.

    // Traitement sur X
    d1 := waves[x+1, y].height - waves[x, y].height;   // Dérivée première à "droite" de x
    d2 := waves[x, y].height   - waves[x-1, y].height; // Dérivée première à "gauche" de x
    ddx := d1 - d2;                                    // Dérivée seconde en x

    // Traitmement sur Y
    d1 := waves[x, y+1].height - waves[x, y].height;
    d2 := waves[x, y].height   - waves[x, y-1].height;
    ddy := d1 - d2;
   
    waves[x, y].speed := waves[x, y].speed + ddx/wavesSpeed + ddy/wavesSpeed;
    end;

  viscosity1 := 1.0-viscosity; 
  for x:=1 to bitmapWidth-1 do
  for y:=1 to bitmapHeight-1 do
    waves[x, y].height := (waves[x, y].height + waves[x, y].speed)*viscosity1;
end;

procedure THIWaveProcessor.simulEdges();
var
  x: integer;
begin
  // Les points (0, 0) et (bitmapWidth, 0) sont traités dans la seconde boucle.
  for x:=1 to bitmapWidth-1 do
    begin
    waves[x, 0] := waves[x, 1];
    waves[x, bitmapHeight] := waves[x, bitmapHeight-1];
    end;
  for x:=0 to bitmapHeight do
    begin
    waves[0, x] := waves[1, x];
    waves[bitmapWidth, x] := waves[bitmapWidth-1, x];
    end;
end;


procedure THIWaveProcessor.ripple(centerX, centerY, radius: integer; height: double);
var
  x: integer;
  y: integer;
begin
  for x:=(centerX-radius) to centerX+radius-1 do
    begin

    if (x>=0) and (x<=bitmapWidth) then
    for y:=centerY-radius to centerY+radius-1 do
      begin

      if (y>=0) and (y<=bitmapHeight) then
        begin
        // Forme de la perturbation obtenue à l'aide de la fonction cosinus
        //                      ____
        //                   __/    \__
        //                 _/          \_
        //                /              \
        //              _/                \_
        //           __/                    \__
        // _________/                          \_________
        waves[x, y].height := waves[x, y].height +( (Cos((x-centerX+radius)/(2*radius)*2*PI - PI)+1)*(Cos((y-centerY+radius)/(2*radius)*2*PI - PI)+1)*height );
        end;

      end;

    end;
end;

procedure THIWaveProcessor.render();
var
  x: integer;
  y: integer;

  background: PByteArray;
  buffer    : PByteArray;

  // Refraction
  dx: double;
  dy: double;
  light: integer;
  xMap: integer;
  yMap: integer;
begin
  // Pour chaque colone
  for y:=0 to bitmapHeight-1 do
    begin
    // Récupération de la colone du background et de l'image
    //buffer := image.picture.bitmap.scanLine[y];

    for x:=0 to bitmapWidth-1 do
      begin
      // Dérivée X et Y
      dx := waves[x+1, y].height-waves[x, y].height;
      dy := waves[x, y+1].height-waves[x, y].height;

      // Calcul déformation
      xMap := x + round(dx*(waves[x,y].height+depth));
      yMap := y + round(dy*(waves[x,y].height+depth));

      // Modification de xMap et yMap pour la faible résolution afin d'avoir une image de meme
      // taille à l'écran qu'en haute résolution
      if halfResolution then
        begin
        xMap := xMap * 2;
        yMap := yMap * 2;
        end;

      // Calcul lumière
      //light := max(0, round(dx*lightIntensity + dy*lightIntensity));
      light := round(dx*lightIntensity + dy*lightIntensity);

      if xMap>=0 then
        xMap := xMap mod Bitmap.Width
        else
        xMap := Bitmap.Width-((-xMap) mod Bitmap.Width)-1;

      if yMap>=0 then
        yMap := yMap mod Bitmap.Height
        else
        yMap := Bitmap.Height-((-yMap) mod Bitmap.Height)-1;

      bitmapLines[y][x*3+0] := min(255, max(0, backgroundLines[yMap][xMap*3+0] + light));
      bitmapLines[y][x*3+1] := min(255, max(0, backgroundLines[yMap][xMap*3+1] + light));
      bitmapLines[y][x*3+2] := min(255, max(0, backgroundLines[yMap][xMap*3+2] + light));
      end;

    end;
end;

end.


Это ещё что... Как-то показал ИИ Незабудку (хайасмовский файл) и вот что вышло. Трей правда не заработал, загрузку/сохранение файла взял от своего gorg, но остальное более-менее. http://soft.self-made-free.ru/Nez_002.tar.zst

Монументально! ("Призрак в опере одобряет!" )
Добавлено спустя 26 минут 6 секунд:
Зы
SHA слегка модифицированной демки (Фон читает из файла "AB.jpg")

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

ver(4.04 build 185)
Add(MainForm,2953706,189,21)
{
Width=533
Height=332
Caption=""
BorderStyle=1
Icon=[ZIP7E03000078DACD51BB12C140143D26855665CC9841A9E30FF8134A7FE1F125FC83469A68A3A06086C6234321C64C34695D7777131B89A07493BB73E7EC3977EF03C8F097CB81CF023A0690075065670815285C58D3C0DF9865595F18370A820B69D0A5F86D4CB223CC48136C89BC25B36D09166118E1733C9592A4F1D3B62697CF7EEDE405127ED14D481C82A9C9ADF5BE3F5FB6367B8130EED04BD9FC7331E3805F3F7983C58A47C4A740C66117D14622F94B323F93DB2AFFE435FF738C335D7FC9F5EBC78FF5C7E6A36C24911DA5AE6C2BA764CA5E4C99396DFED1FD3A927620BDEBB49525E53F5A0A9FBAC0BDA1FC5A645A56F9C150DE838EC33BC1133AE10F414BBEF1]
Point(onKeyDown)
Point(onMouseDown)
link(onCreate,8583282:doEvent1,[(285,41)(285,69)])
link(onKeyDown,16065103:doWork1,[(245,48)])
}
Add(WaveProcessor,5650547,315,203)
{
Viscosity=2
Luminosity=300
Profondeur=473
Radius=10
Height=-1
link(Image,10114973:Bitmap,[(321,183)(304,183)(304,256)(153,256)])
link(Bitmap,9033637:Var2,[])
}
Add(PaintBox,10114973,147,203)
{
Left=5
Top=5
Width=513
Height=296
Align=5
Color=16777215
Point(MouseX)
Point(MouseY)
Point(onMouseMove)
Point(onMouseDown)
link(onBeforeDraw,5650547:doProcess,[])
link(onMouseMove,12889552:doData,[])
link(onMouseDown,16065103:doWork3,[(357,223)(357,147)(305,147)(305,105)(277,105)(267,62)])
}
Add(Timer,3633506,98,203)
{
Interval=1
link(onTimer,10114973:doRefresh,[])
}
Add(Bitmap,15164174,483,28)
{
}
Add(Timer,7775526,98,119)
{
Interval=500
link(onTimer,3534662:doRandom,[])
}
Add(Random,3534662,147,119)
{
Max=512
link(onRandom,7827597:doRandom,[])
}
Add(Random,7827597,196,119)
{
Max=295
link(onRandom,315426:doAdd,[])
}
Add(MT_Add,315426,245,119)
{
InputMT=1
link(onAdd,12827665:doWork1,[(291,125)])
link(Data,3534662:Random,[(251,107)(232,107)(232,163)(153,163)])
}
Add(HubEx,12827665,287,210)
{
link(onEvent,5650547:doRipple,[])
}
Add(DoData,12889552,196,210)
{
link(onEventData,2843884:doAdd,[])
link(Data,10114973:MouseY,[(202,196)(188,196)(188,247)(167,247)])
}
Add(MT_Add,2843884,245,210)
{
InputMT=1
link(onAdd,12827665:doWork2,[])
link(Data,10114973:MouseX,[(251,195)(233,195)(233,252)(160,252)])
}
Add(Img_Text,6455406,532,119)
{
Y=250
Font=[MS Sans Serif,8,0,16777215,1]
Text="HiAsm изменит твою жизнь и твой разум..."
Point(X)
link(Bitmap,16062449:Var3,[(538,100)])
}
Add(Counter,4206695,483,119)
{
Min=-200
Max=560
Default=-200
link(onNext,6455406:doDraw,[])
}
Add(Timer,15756550,385,119)
{
Interval=20
link(onTimer,5481892:doDraw,[])
}
Add(Bitmap,10723493,350,14)
{
HWidth=513
HHeight=296
Point(doCreate)
}
Add(Img_Bmp,5481892,434,119)
{
link(onDraw,4206695:doNext,[])
link(Bitmap,16062449:Var2,[])
link(SourceBitmap,15164174:Bitmap,[(447,89)(489,89)])
}
Add(GetDataEx,9033637,322,95)
{
link(Data,10723493:Bitmap,[(328,81)(356,81)])
}
Add(GetDataEx,16062449,434,95)
{
Angle=3
link(Data,9033637:Var3,[])
}
Add(Hub,8583282,294,63)
{
link(onEvent1,9885651:doEvent1,[(360,69)(360,62)])
link(onEvent2,10723493:doCreate,[(329,76)(329,34)])
}
Add(Jpeg,8635809,413,56)
{
Point(FileName)
Point(doBitmap)
link(onBitmap,15164174:doLoad,[(464,62)(464,34)])
link(FileName,6457839:Value,[(419,44)(398,44)])
}
Add(Memory,6457839,392,0)
{
Default=String(AB.JPG)
}
Add(Hub,9885651,371,56)
{
link(onEvent1,8635809:doLoad,[])
link(onEvent2,8635809:doBitmap,[(399,69)(399,76)])
}
Add(HubEx,16065103,241,56)
{
Angle=1
link(onEvent,2953706:doClose,[(245,81)(180,81)(180,48)])
}


Заработало !
(Слегка медленней и волны более широкие но в целом похоже )

deepseek с HiAsm знаком но писать полный код аналог не стал (лениво ему )
Ну ладно скормил ему исходник WaveProcessor-а и запросили "перевод с паскаля на паскаль" ( то бишь потребовал написать адаптацию для Лазаруса)
Сделал, просил демку написал и её ... Но что-то не то ...

Приведенная в начале этого диалога демка на Hiasm могла генерировать несколько волн параллельно (с разными начальными точкам ) может ли это делать класс TWaveProcessor ? Если нет то как этого добиться ?

Дип Сек извинился и переписал демку ...
Все ок ... (добавил {$mode delphi} код скомпилировался ) но ничего не работает...
начал копать код вначале уперся в PaintBox ( видимо забыл какие-то тонкости потому что мой старый проект с PaintBox успешно собрался и заработал ) (Заменил PaintBox на TImage) Дальше уперся в то что deepseek не вник в отличия KOL и VCL , ладно приписал способ адресации все равно не работает (хотя ошибок не выдает ) ...
Потом вспомнил что FWaveProcessor.Process(FImage, FBitmap); вызывается еще и в обработчике таймера
"Закавычил" и его .

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

  fbitmap.BeginUpdate;
     FWaveProcessor.Process(FImage, FBitmap);
  fbitmap.EndUpdate;


И тут все наконец завертелось .

Добавлено спустя 54 минуты 37 секунд:
Модифицированный WaveProcessorUnit

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

unit WaveProcessorUnit;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Graphics, LCLType, Math;

type
  TWave = record
    Height: Double;
    Speed: Double;
  end;

  TByteArray = array of Byte;
  PByteArray = ^TByteArray;

  { TWaveProcessor }

  TWaveProcessor = class
  private
    FBitmapWidth: Integer;
    FBitmapHeight: Integer;
    FBackgroundLines: array of PByteArray;
    FBitmapLines: array of PByteArray;
    FHalfResolution: Boolean;

    FImage, FBitmap: TBitmap;

    FWaves: array of array of TWave;

    FLightIntensity: Double; // Интенсивность эффекта света
    FDepth: Double;          // Глубина воды для псевдо-рефракции
    FViscosity: Double;      // Псевдо-вязкость для анимации
    FWavesSpeed: Double;     // Параметр для скорости волн (должен быть не менее 2.0)

    FLastT: Integer;
    FFPSCount: Integer;

    procedure Init;
    procedure InitWavesArray;
    procedure InitWavesData;
    procedure InitBackgroundLines;
    procedure InitBitmapLines;

    procedure Simulate;
    procedure SimulateEdges;
    procedure Ripple(CenterX, CenterY, Radius: Integer; Height: Double);

    procedure Render;
    procedure Idle;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Process(Image, Bitmap: TBitmap);
    procedure MakeRipple(X, Y, Radius: Integer; Height: Double);

    property Viscosity: Double read FViscosity write FViscosity;
    property WavesSpeed: Double read FWavesSpeed write FWavesSpeed;
    property LightIntensity: Double read FLightIntensity write FLightIntensity;
    property Depth: Double read FDepth write FDepth;
  end;

implementation

{ TWaveProcessor }

constructor TWaveProcessor.Create;
begin
  inherited Create;
  FImage := TBitmap.Create;
  FBitmap := TBitmap.Create;
end;

destructor TWaveProcessor.Destroy;
begin
  FImage.Free;
  FBitmap.Free;
  inherited Destroy;
end;

procedure TWaveProcessor.Init;
begin
  FHalfResolution := False;
  FBitmapWidth := FImage.Width;
  FBitmapHeight := FImage.Height;

  FLightIntensity := 300;
  FWavesSpeed := 2.0;
  FViscosity := 0.02;
  FDepth := 47.3;

  InitBitmapLines;
  InitBackgroundLines;

  InitWavesArray;
  InitWavesData;
end;

procedure TWaveProcessor.InitWavesArray;
var
  X: Integer;
begin
  SetLength(FWaves, FBitmapWidth + 1);
  for X := 0 to FBitmapWidth do
    SetLength(FWaves[X], FBitmapHeight + 1);
end;

procedure TWaveProcessor.InitWavesData;
var
  X, Y: Integer;
begin
  for X := 0 to FBitmapWidth do
    for Y := 0 to FBitmapHeight do
    begin
      FWaves[X, Y].Height := 0.0;
      FWaves[X, Y].Speed := 0.0;
    end;
end;

procedure TWaveProcessor.InitBackgroundLines;
var
  I: Integer;
begin
  FBitmap.PixelFormat := pf24bit;
//  SetLength(FBackgroundLines, FBitmap.Height);
//  for I := 0 to FBitmap.Height - 1 do
//    FBackgroundLines[I] := FBitmap.ScanLine[I];
end;

procedure TWaveProcessor.InitBitmapLines;
var
  I: Integer;
begin
  FImage.PixelFormat := pf24bit;
// SetLength(FBitmapLines, FBitmapHeight);
//  for I := 0 to FBitmapHeight - 1 do
//    FBitmapLines[I] := FImage.ScanLine[I];
end;

procedure TWaveProcessor.Simulate;
var
  X, Y: Integer;
  D1, D2, Ddx, Ddy, Viscosity1: Double;
begin

  for X := 1 to FBitmapWidth - 1 do
    for Y := 1 to FBitmapHeight - 1 do
    begin
      D1 := FWaves[X + 1, Y].Height - FWaves[X, Y].Height;
      D2 := FWaves[X, Y].Height - FWaves[X - 1, Y].Height;
      Ddx := D1 - D2;

      D1 := FWaves[X, Y + 1].Height - FWaves[X, Y].Height;
      D2 := FWaves[X, Y].Height - FWaves[X, Y - 1].Height;
      Ddy := D1 - D2;

      FWaves[X, Y].Speed := FWaves[X, Y].Speed + Ddx / FWavesSpeed + Ddy / FWavesSpeed;
    end;

  Viscosity1 := 1.0 - FViscosity;
  for X := 1 to FBitmapWidth - 1 do
    for Y := 1 to FBitmapHeight - 1 do
      FWaves[X, Y].Height := (FWaves[X, Y].Height + FWaves[X, Y].Speed) * Viscosity1;
end;

procedure TWaveProcessor.SimulateEdges;
var
  X: Integer;
begin
  for X := 1 to FBitmapWidth - 1 do
  begin
    FWaves[X, 0] := FWaves[X, 1];
    FWaves[X, FBitmapHeight] := FWaves[X, FBitmapHeight - 1];
  end;
  for X := 0 to FBitmapHeight do
  begin
    FWaves[0, X] := FWaves[1, X];
    FWaves[FBitmapWidth, X] := FWaves[FBitmapWidth - 1, X];
  end;
end;

procedure TWaveProcessor.Ripple(CenterX, CenterY, Radius: Integer; Height: Double);
var
  X, Y: Integer;
begin
  for X := (CenterX - Radius) to (CenterX + Radius - 1) do
  begin
    if (X >= 0) and (X <= FBitmapWidth) then
      for Y := (CenterY - Radius) to (CenterY + Radius - 1) do
      begin
        if (Y >= 0) and (Y <= FBitmapHeight) then
          FWaves[X, Y].Height := FWaves[X, Y].Height + ((Cos((X - CenterX + Radius) / (2 * Radius) * 2 * PI - PI) + 1) * (Cos((Y - CenterY + Radius) / (2 * Radius) * 2 * PI - PI) + 1) * Height);
      end;
  end;
end;

procedure TWaveProcessor.Render;
var
  I, X, Y: Integer;
  Background, Buffer: PByteArray;
  Dx, Dy: Double;
  Light, XMap, YMap: Integer;
  P1,P2:Pointer;
begin

  for Y := 0 to FBitmapHeight - 1 do
  begin
    for X := 0 to FBitmapWidth - 1 do
    begin
      Dx := FWaves[X + 1, Y].Height - FWaves[X, Y].Height;
      Dy := FWaves[X, Y + 1].Height - FWaves[X, Y].Height;

      XMap := X + Round(Dx * (FWaves[X, Y].Height + FDepth));
      YMap := Y + Round(Dy * (FWaves[X, Y].Height + FDepth));

      if FHalfResolution then
      begin
        XMap := XMap * 2;
        YMap := YMap * 2;
      end;

      Light := Round(Dx * FLightIntensity + Dy * FLightIntensity);

      if XMap >= 0 then
        XMap := XMap mod FBitmap.Width
      else
        XMap := FBitmap.Width - ((-XMap) mod FBitmap.Width) - 1;

      if YMap >= 0 then
        YMap := YMap mod FBitmap.Height
      else
        YMap := FBitmap.Height - ((-YMap) mod FBitmap.Height) - 1;

       P2:=FBitmap.RawImage.Data;
       P2:=P2+(FBitmap.Width*Y*3)+X * 3 ;
       P1:=FImage.RawImage.Data;
       P1:=P1+(FBitmap.Width*Y*3)+X * 3 ;

     for I:=0 to 2 do begin Inc (P1,I);Inc (P2,I);
     Byte(P2^):=Min(255, Max(0, Byte(P1^)+ Light));
     end;

      //FBitmapLines[Y][X * 3 + 0] := Min(255, Max(0, FBackgroundLines[YMap][XMap * 3 + 0] + Light));
      //FBitmapLines[Y][X * 3 + 1] := Min(255, Max(0, FBackgroundLines[YMap][XMap * 3 + 1] + Light));
      //FBitmapLines[Y][X * 3 + 2] := Min(255, Max(0, FBackgroundLines[YMap][XMap * 3 + 2] + Light));
    end;
  end;

end;

procedure TWaveProcessor.Idle;
begin
  SimulateEdges;
  Simulate;
  Render;
end;

procedure TWaveProcessor.Process(Image, Bitmap: TBitmap);
begin
  if FImage <> Image then
  begin
    FImage := Image;
    FBitmap := Bitmap;
    Init;
  end;
  InitBackgroundLines;
  Idle;
end;

procedure TWaveProcessor.MakeRipple(X, Y, Radius: Integer; Height: Double);
begin
  Ripple(X, Y, Radius, Height);
end;

end.


Демка

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

unit MainFormUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, WaveProcessorUnit;

type

  { TMainForm }

  TMainForm = class(TForm)
    Image1: TImage;
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TimerTimer(Sender: TObject);
  private
    FImage: TBitmap;
    FBitmap: TBitmap;
    FWaveProcessor: TWaveProcessor;
    procedure GenerateRandomRipple; // Метод для генерации случайной волны
  public
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // Загрузка изображения
  Image1.Picture.LoadFromFile('background.bmp');
  FImage := TBitmap.Create;
  FImage.SetSize(Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
  FImage.PixelFormat:=pf24bit;
  FImage.Canvas.Draw(0,0,Image1.Picture.Bitmap);


  // Создание битмапа для отрисовки
  FBitmap := TBitmap.Create;
  FBitmap. PixelFormat:=pf24bit;
  FBitmap.SetSize(FImage.Width, FImage.Height);

  // Инициализация WaveProcessor
  FWaveProcessor := TWaveProcessor.Create;
   fbitmap.BeginUpdate;
  FWaveProcessor.Process(FImage, FBitmap);
  fbitmap.EndUpdate;

  // Настройка таймера
  Timer.Interval := 16; // ~60 FPS
  Timer.Enabled := True;
end;


procedure TMainForm.FormDestroy(Sender: TObject);
begin
  // Освобождение ресурсов
  FWaveProcessor.Free;
  FBitmap.Free;
  FImage.Free;
end;


procedure TMainForm.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
// Создание волны при клике мышью
  FWaveProcessor.MakeRipple(X, Y, 20, 10.0); // Радиус 20, высота волны 10.0
end;


procedure TMainForm.TimerTimer(Sender: TObject);
begin
  // Генерация случайной волны каждые 500 мс
  if Random(100) < 10 then // 10% вероятность генерации волны
    GenerateRandomRipple;

  // Обработка волнового эффекта
     fbitmap.BeginUpdate;
  FWaveProcessor.Process(FImage, FBitmap);
    fbitmap.EndUpdate;
  // Отрисовка результата на PaintBox
  Image1.Picture.Bitmap.Canvas.Draw(0, 0, FBitmap);
end;

procedure TMainForm.GenerateRandomRipple;
var
  X, Y: Integer;
begin
  // Генерация случайных координат для волны
  X := Random(FBitmap.Width);
  Y := Random(FBitmap.Height);

  // Создание волны
  FWaveProcessor.MakeRipple(X, Y, 20 + Random(30), 5.0 + Random(10));
end;

end.


Красиво получилось!

Alexander писал(а):Красиво получилось!

1 Что у тебя тоже заработало ? (надо будет фон получше подобрать )
2 Что красиво это ладно главное там интересная методика формирования эффекта волн.
(Еще бы эффект преломления и легкий "продольный длинноволновой бриз" добавить и будет вообще блеск ! )
3 Интересно можно ли в шейдер такой ВэйвПпроцеесор засунуть или хотя-бы просто OpenGL версию сделать .

Зы
Слегка модифицировал демку для большего сходства с оригиналом
(теперь можно зажать кнопку и водить курсором "по воде" )

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

unit MainFormUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, WaveProcessorUnit;

type

  { TMainForm }

  TMainForm = class(TForm)
    Image1: TImage;
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TimerTimer(Sender: TObject);
  private
    FImage: TBitmap;
    FBitmap: TBitmap;
    FWaveProcessor: TWaveProcessor;
    procedure GenerateRandomRipple; // Метод для генерации случайной волны
  public
   Const MD:Boolean =False;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // Загрузка изображения
  Image1.Picture.LoadFromFile('background.bmp');
  FImage := TBitmap.Create;
  FImage.SetSize(Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
  FImage.PixelFormat:=pf24bit;
  FImage.Canvas.Draw(0,0,Image1.Picture.Bitmap);
  //LoadFromFile('background.bmp'); // Укажите путь к вашему изображению


  // Создание битмапа для отрисовки
  FBitmap := TBitmap.Create;
  FBitmap. PixelFormat:=pf24bit;
  FBitmap.SetSize(FImage.Width, FImage.Height);

  // Инициализация WaveProcessor
  FWaveProcessor := TWaveProcessor.Create;
   fbitmap.BeginUpdate;
  FWaveProcessor.Process(FImage, FBitmap);
  fbitmap.EndUpdate;

  // Настройка таймера
  Timer.Interval := 16; // ~60 FPS
  Timer.Enabled := True;
end;


procedure TMainForm.FormDestroy(Sender: TObject);
begin
  // Освобождение ресурсов
  FWaveProcessor.Free;
  FBitmap.Free;
  FImage.Free;
end;


procedure TMainForm.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
// Создание волны при клике мышью
  FWaveProcessor.MakeRipple(X, Y, 20, 10.0); // Радиус 20, высота волны 10.0
  If Button=mbLeft then md:=True;
end;

procedure TMainForm.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  If MD then   FWaveProcessor.MakeRipple(X, Y, 20, 10.0);
  // Радиус 20, высота волны 10.0
end;

procedure TMainForm.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
If Button=mbLeft then md:=False;
end;


procedure TMainForm.TimerTimer(Sender: TObject);
begin
  // Генерация случайной волны каждые 500 мс
  if Random(100) < 10 then // 10% вероятность генерации волны
    GenerateRandomRipple;

  // Обработка волнового эффекта
     fbitmap.BeginUpdate;
  FWaveProcessor.Process(FImage, FBitmap);
    fbitmap.EndUpdate;
  // Отрисовка результата на PaintBox
  Image1.Picture.Bitmap.Canvas.Draw(0, 0, FBitmap);
end;

procedure TMainForm.GenerateRandomRipple;
var
  X, Y: Integer;
begin
  // Генерация случайных координат для волны
  X := Random(FBitmap.Width);
  Y := Random(FBitmap.Height);

  // Создание волны
  FWaveProcessor.MakeRipple(X, Y, 20 + Random(30), 5.0 + Random(10));
end;
end.


Я про демо. Запустить пока не удалось. Может быть это можно оформить потом как проект.