Demo Scene BGRA GL Shader lazarus / 39-Graphics ---------------------------------------------------------------------- Gigatron · 2024-07-02 22:36 Hi, I would like to share this nice demo code with you; so enjoy the silents. Will post the result on YT quickly ; https://www.youtube.com/watch?v=3y33g23ckpI Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL, BGRACheckerBoardGL, BGRABitmapTypes,mmsystem; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    gtr_logo,gl_surface: IBGLTexture;    logo_xpos : integer;    checker: TBGLCheckerBoardShader;    MainFont: IBGLFont;    line_message :Array of PChar;    LineXpos,   LineYpos : Single;     // dot plot    s,a : single;    alfa,alfa_time,plot_dir : integer;  public   MyAudio_File: AnsiString;  WavStream : TMemoryStream;   end; var  Form1: TForm1; implementationuses  GL; {$R *.lfm} { TForm1 }  procedure TForm1.FormCreate(Sender: TObject);begin  MainFont := BGLFont('AmigaParadox',40);   SetLength(line_message, 1);  line_message[0] :=  (' HELLO  GIGATRON BEYOND SUB-QUANTUM PRESENTS BGRA CHECKERBOARD GL FRAGMENT SHADER  DEMO CODED WITH LAZARUS FPC USED BGRA COMPONENT THANX TO CIRCULAR WHO INCLUDED GLSL SHADER  SFX : BY ESTRAYK OF PARADOX SEE YOU ON NEXT PRODUCTION ........');  LineXPos := 3000;  LineYpos := 440;  // plot fx   s := 255/sqrt(3)*2/30;   a := 0.0;  // angle   alfa :=0;   // logo x pos   logo_xpos:= -800;     // audio stream    MyAudio_File := 'euskal.wav';    WavStream    := TMemoryStream.Create;    WavStream.LoadFromFile(MyAudio_File);    PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY); end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);var gl_pix: IBGLTexture;  i : integer;   xx,yy : integer;  r,z,x1,x2,y1,y2 : single; begin    checker.Time:= checker.Time +0.030;    gl_pix := checker.Render(gl_surface );    BGLContext.Canvas.PutImage(0,0, gl_pix);    BGLContext.Canvas.PutImage(logo_xpos,0, gtr_logo);       for  i := 0 to  Length(line_message[0])-1 do    begin     if LinexPos < -Length(line_message[0]) * 22  then LinexPos := 800;     LinexPos := LineXPos - 0.015;     LineyPos := 460;     MainFont.TextOut(i * 22  + LinexPos+5,(  LineYPos   )+5, line_message[0][i]);    end;   // plot fx      for xx:=15 downto -15 do       begin       for yy:=15 downto -15 do        begin        r := (sqrt(xx*xx+yy*yy))+2;       z := 40*sin(r+a*0.6)/r*0.8;        x2 := xx*cos(a*PI/180)-yy*sin(a*PI/180);       y2 := xx*sin(a*PI/180)+yy*cos(a*PI/180);        x1 := round(360+(y2-x2)*s*sqrt(3)/2);       y1 := round(300+z-(y2+x2)*s/2);        BGLContext.Canvas.Rectangle(Rect(Round(x1), Round(y1),Round(x1+2), Round(y1+2)),BGRA(alfa,alfa,alfa));         end;       end;       if(plot_dir=1) then  a := a + 0.2;      if(plot_dir=2) then  a := a - 0.2; end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin   gtr_logo := BGLTexture(ResourceFile('gtr.png'));  gl_surface := BGLTexture(ResourceFile('gl_surface.png'));   checker := TBGLCheckerBoardShader.Create(BGLContext.Canvas); end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  gl_surface := nil;  gtr_logo   := nil;  FreeAndNil(checker); end;  procedure TForm1.Timer1Timer(Sender: TObject);begin      inc(alfa);      if (alfa>=254) then alfa :=255;     inc(alfa_time);      if(alfa_time>300+Random(450)) then      begin        alfa_time :=0;        plot_dir := 1+Random(2);      end;       inc(logo_xpos,5);      if(logo_xpos>=30) then logo_xpos :=30;       BGLVirtualScreen1.Invalidate;end; end.  Checker Board shader unit hope no mistake inside ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { Checkerboard effect using OpenGL shaders }unit BGRACheckerBoardGL; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Shader computing Checkerboard }  TBGLCheckerBoardShader = class(TBGLShader3D)  private    function GetImageIndex: integer;    function GetTime: Single;    procedure SetImageIndex(AValue: integer);    procedure SetTime(AValue: Single);   protected     FImageIndex: TUniformVariableInteger;    FTime:     TUniformVariableSingle;    procedure StartUse; override;   public    constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;    property ImageIndex: integer read GetImageIndex write SetImageIndex;    property Time: Single read GetTime write SetTime;   end; implementation { TBGLCheckerBoardShader } function TBGLCheckerBoardShader.GetImageIndex: integer;begin  result := FImageIndex.Value;end; function TBGLCheckerBoardShader.GetTime: Single;begin  result := FTime.Value;end; procedure TBGLCheckerBoardShader.SetImageIndex(AValue: integer);begin  FImageIndex.Value := AValue;end; procedure TBGLCheckerBoardShader.SetTime(AValue: Single);begin    FTime.Value := AValue;end; constructor TBGLCheckerBoardShader.Create(ACanvas: TBGLCustomCanvas); begin// vertex + fragmentinherited Create(ACanvas,'void main(void) {'#10 +'       gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +'    texCoord = vec2(gl_MultiTexCoord0);'#10 +'}', 'uniform sampler2D image;'#10 +'uniform float time;'#10 +'out vec4 FragmentColor;'#10 + 'void main(void)'#10 +'{'#10 +'vec2 pos = texCoord - vec2(0.5,0.5);     '#10 +' float horizon = 0.0;  '#10 +' float fov = 0.5;      '#10 +' float scaling = 0.4;  '#10 +' vec3 p = vec3(pos.x, fov, pos.y - horizon);'#10 +' vec2 s = vec2(p.x/p.z, p.y/p.z) * scaling; '#10 +' float f = 1.0;                             '#10 +' //checkboard                             '#10 +' float col = sign((mod(s.x*f+cos(time*0.3), 0.1*f) - 0.05) * (mod(s.y*f+sin(time*0.2), 0.1*f) - 0.05));'#10 +' col *= p.z*p.z*5.0*(1.0 - abs(p.x));'#10 + ' FragmentColor = vec4( vec3(col*1.0,col*0.0,col*0.0), 1.0 ); '#10 + '}', 'varying vec2 texCoord;', '130');   FImageIndex := UniformInteger['image'];  FTime := UniformSingle['time'];      // float uniform  ImageIndex:= 0;  Time := 0;end; function TBGLCheckerBoardShader.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;  Canvas.Fill(BGRAPixelTransparent);  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;end; procedure TBGLCheckerBoardShader.StartUse;begin  inherited StartUse;  FImageIndex.Update;  FTime.Update;end; end. ---------------------------------------------------------------------- Joanna · 2024-07-03 11:31 I don’t know much about this type of programming but I enjoyed your video. I like the old style simple sounds. ---------------------------------------------------------------------- Gigatron · 2024-07-03 12:46 Quote from: Joanna on July 03, 2024, 01:31:11 pmI don’t know much about this type of programming but I enjoyed your video. I like the old style simple sounds. Hi , @Joanna i'am glad you liked it. If I did not install the BGA component everything I code on the demo scene theme would not exist. Once again here I thank the brilliant @circular who is the author of the component. In addition, including glsl (pixel shader)  in the code makes it easier to add annimation effects. Who said that Easter language was old and limited? Regards Gtr ---------------------------------------------------------------------- circular · 2024-07-03 14:08 Hi Gigatron, Very nice checkerboard! In fact, you don't need to provide a texture to draw with a shader. Here is an adapter version of your shader that can generate a texture for a given size, or directly on the canvas. The idea is to compute the coordinate from the vertex coordinate. Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { Checkerboard effect using OpenGL shaders }unit BGRACheckerBoardGL; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Shader computing Checkerboard }  TBGLCheckerBoardShader = class(TBGLShader3D)  private    function GetCanvasSize: TPointF;    function GetTime: Single;    procedure SetCanvasSize(AValue: TPointF);    procedure SetTime(AValue: Single);   protected     FCanvasSize: TUniformVariablePointF;    FTime:     TUniformVariableSingle;    procedure StartUse; override;  property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;   public    constructor Create(ACanvas: TBGLCustomCanvas);    function Render(AWidth, AHeight: integer): IBGLTexture; overload;    procedure RenderOnCanvas;    property Time: Single read GetTime write SetTime;   end; implementation { TBGLCheckerBoardShader } function TBGLCheckerBoardShader.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; function TBGLCheckerBoardShader.GetTime: Single;begin  result := FTime.Value;end; procedure TBGLCheckerBoardShader.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end; procedure TBGLCheckerBoardShader.SetTime(AValue: Single);begin    FTime.Value := AValue;end; constructor TBGLCheckerBoardShader.Create(ACanvas: TBGLCustomCanvas); begin// vertex + fragmentinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'    gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +'    gl_FrontColor = gl_Color;'#10 +'    texCoord = gl_Vertex.xy / canvasSize;'#10 +'}', 'uniform float time;'#10 +'out vec4 FragmentColor;'#10 +'void main(void)'#10 +'{'#10 +' vec2 pos = texCoord - vec2(0.5,0.5);     '#10 +' float horizon = 0.0;  '#10 +' float fov = 0.5;      '#10 +' float scaling = 0.4;  '#10 +' vec3 p = vec3(pos.x, fov, pos.y - horizon);'#10 +' vec2 s = vec2(p.x/p.z, p.y/p.z) * scaling; '#10 +' float f = 1.0;                           '#10 +' //checkboard                               '#10 +' float col = sign((mod(s.x*f+cos(time*0.3), 0.1*f) - 0.05) * (mod(s.y*f+sin(time*0.2), 0.1*f) - 0.05));'#10 +' col *= p.z*p.z*5.0*(1.0 - abs(p.x));'#10 + ' FragmentColor = vec4(col*gl_Color.xyz, 1.0); '#10 + '}', 'varying vec2 texCoord;', '130');   FCanvasSize := UniformPointF['canvasSize'];  FTime := UniformSingle['time'];      // float uniform  Time := 0;end; function TBGLCheckerBoardShader.Render(AWidth, AHeight: integer): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;begin  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(AWidth, AHeight);  Canvas.ActiveFrameBuffer := buf;  Canvas.Fill(BGRAPixelTransparent);  RenderOnCanvas;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;end; procedure TBGLCheckerBoardShader.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(Canvas.Width, Canvas.Height);  Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSYellow);  Canvas.Lighting.ActiveShader := previousShader;end; procedure TBGLCheckerBoardShader.StartUse;begin  inherited StartUse;  FCanvasSize.Update;  FTime.Update;end; end. ---------------------------------------------------------------------- Gigatron · 2024-07-03 14:21 Quote from: circular on July 03, 2024, 04:08:38 pm In fact, you don't need to provide a texture to draw with a shader. Here is an adapter version of your shader that can generate a texture for a given size, or directly on the canvas. The idea is to compute the coordinate from the vertex coordinate. I don't say master for nothing, you are one, I was going to ask you that, that is to say the minimal code for glsl. Your code is of perfect use to me. Many thanks Thanks @circular, I was studying the code at the moment. ---------------------------------------------------------------------- Gigatron · 2024-07-04 13:27 Hi , I consider this demo to be finished and now let's share the code if you want to improve it or extract some part of code; So if you want simple pass shader without buffered feel free to contact me; The shader must be public domain and not copyrighted ! Main unit: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL, BGRACheckerBoardGL, BGRABitmapTypes,GL,mmsystem; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    gtr_logo  : IBGLTexture;    logo_xpos : integer;    checker: TBGLCheckerBoardShader;    MainFont: IBGLFont;    line_message :Array of PChar;    LineXpos,   LineYpos, bounce,fct  : Single;    // color select    C_color : integer;     // dot plot    s,a,ag : single;    alfa,alfa_time,plot_dir,p_x : integer;  public   MyAudio_File: AnsiString;  WavStream : TMemoryStream;   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  MainFont := BGLFont('AmigaParadox',60);   SetLength(line_message, 1);  line_message[0] :=  (' HELLO  GIGATRON BEYOND THE SUB - QUANTUM PRESENTS BGRA CHECKERBOARD GL FRAGMENT SHADER DEMO. CODED WITH LAZARUS FPC USING BGRA COMPONENT THANX TO CIRCULAR WHO INCLUDED GLSL SHADER -  SFX : 16-BEAT / RAZOR 1911 SEE YOU ON NEXT PRODUCTION ........');  LineXPos := 2800;  LineYpos := 460;  bounce := 0.0;  fct    := 0.0;  // plot fx   s := 255/sqrt(3)*2/30;   a := 0.0;   p_x := -1400;   // angle   ag := 0.0;   alfa :=0;   // logo x pos   logo_xpos:= -800;   // checker color   C_color :=0;     // audio stream    MyAudio_File := 'itspheno.wav';    WavStream    := TMemoryStream.Create;    WavStream.LoadFromFile(MyAudio_File);    PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY); end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);var  i : integer;  xx,yy : integer;  r,z,x1,x2,y1,y2 : single; begin      checker.Time:= checker.Time +0.030;      checker.Fcolor := C_color;      checker.RenderOnCanvas;    BGLContext.Canvas.PutImage(logo_xpos,0, gtr_logo,alfa);    // plot fx      for xx:=15 downto -15 do       begin         for yy:=15 downto -15 do          begin            r := (sqrt(xx*xx+yy*yy))+2;           z := 40*sin(r+a*0.6)/r*0.8;            x2 := xx*cos(a*PI/180)-yy*sin(ag*PI/180);           y2 := xx*sin(a*PI/180)+yy*cos(ag*PI/180);            x1 := round(360+(y2-x2)*s*sqrt(3)/2);           y1 := round(300+z-(y2+x2)*s/2);           BgLContext.Canvas.Arc(x1+p_x,y1,2, 2,0,360,BGRA(alfa,alfa,alfa),false,BGRA(180,180,180));           end;       end;        ag := ag - 0.1;         for  i := 0 to  Length(line_message[0])-1 do      begin       if LinexPos < -Length(line_message[0]) * 30  then       begin       LinexPos := 800;       end;       LinexPos := LineXPos - 0.012;       LineyPos := 460;       MainFont.TextOut(i * 30  + LinexPos+4,LineYPos-50*abs(sin(bounce)*2)+2 , line_message[0][i],BGRA(255,255,255));       MainFont.TextOut(i * 30  + LinexPos,LineYPos-50*abs(sin(bounce)*2) , line_message[0][i],BGRA(20,120,255));      end;       bounce := bounce + 0.04;        if(plot_dir=1) then  a := a + 0.2;      if(plot_dir=2) then  a := a - 0.2; end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin   gtr_logo := BGLTexture(ResourceFile('phex.png'));  checker := TBGLCheckerBoardShader.Create(BGLContext.Canvas); end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  gtr_logo   := nil;  FreeAndNil(checker);end; procedure TForm1.Timer1Timer(Sender: TObject);begin      inc(alfa_time);      if(alfa_time>300+Random(600)) then      begin        alfa_time :=0;        plot_dir := 1+Random(2);        C_color := C_color + 1;        if(C_color>=4) then C_color:=0;    end;       inc(logo_xpos,5);      if(logo_xpos>=30) then      begin      inc(alfa);      if (alfa>=250) then alfa :=250;      logo_xpos :=30;      end;       inc(p_x,20);      if(p_x>=20) then p_x :=20;       BGLVirtualScreen1.Repaint;end; end.  Checker_Board Unit ; thx to @circular for the latest simple and small code : Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { Checkerboard effect using OpenGL shaders }unit BGRACheckerBoardGL; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Shader computing Checkerboard }  TBGLCheckerBoardShader = class(TBGLShader3D)  private    function GetCanvasSize: TPointF;    function GetTime: Single;    procedure SetTime(AValue: Single);    function  GetColor: Integer;    procedure SetColor(AValue: Integer);     procedure SetCanvasSize(AValue: TPointF);    protected     FCanvasSize: TUniformVariablePointF;    FTime:       TUniformVariableSingle;    Fcol :       Integer;    procedure StartUse; override;    property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;   public    constructor Create(ACanvas: TBGLCustomCanvas);    function Render(AWidth, AHeight: integer): IBGLTexture; overload;    procedure RenderOnCanvas;    property Time: Single read GetTime write SetTime;    property Fcolor: Integer read GetColor write SetColor;   end; implementation { TBGLCheckerBoardShader } function TBGLCheckerBoardShader.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; function TBGLCheckerBoardShader.GetTime: Single;begin  result := FTime.Value;end; procedure TBGLCheckerBoardShader.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end; procedure TBGLCheckerBoardShader.SetTime(AValue: Single);begin    FTime.Value := AValue;end; function TBGLCheckerBoardShader.GetColor: Integer;begin  result := FCol;end; procedure TBGLCheckerBoardShader.SetColor(AValue: Integer);begin    FCol := AValue;end; constructor TBGLCheckerBoardShader.Create(ACanvas: TBGLCustomCanvas); begin// vertex + fragmentinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'    gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +'    gl_FrontColor = gl_Color;'#10 +'    texCoord = gl_Vertex.xy / canvasSize;'#10 +'}', 'uniform float time;'#10 +'out vec4 FragmentColor;'#10 +'void main(void)'#10 +'{'#10 +' vec2 pos = texCoord - vec2(0.5,0.5);     '#10 +' float horizon = 0.0;  '#10 +' float fov = 0.5;      '#10 +' float scaling = 0.4;  '#10 +' vec3 p = vec3(pos.x, fov, pos.y - horizon);'#10 +' vec2 s = vec2(p.x/p.z, p.y/p.z) * scaling; '#10 +' float f = 1.0;                             '#10 +' //checkboard                             '#10 +' float col = sign((mod(s.x*f+cos(time*0.3), 0.1*f) - 0.05) * (mod(s.y*f+sin(time*0.2), 0.1*f) - 0.05));'#10 +' col *= p.z*p.z*5.0*(1.0 - abs(p.x));'#10 + ' FragmentColor = vec4(col*gl_Color.xyz, 1.0); '#10 + '}', 'varying vec2 texCoord;', '130');   FCanvasSize := UniformPointF['canvasSize'];  FTime := UniformSingle['time'];      // float uniform   Fcol :=1;  Time := 0;end; function TBGLCheckerBoardShader.Render(AWidth, AHeight: integer): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;begin  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(AWidth, AHeight);  Canvas.ActiveFrameBuffer := buf;  Canvas.Fill(BGRAPixelTransparent);  RenderOnCanvas;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;end; procedure TBGLCheckerBoardShader.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(Canvas.Width, Canvas.Height);   Case   FCol of  0: Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSRed);  1: Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSYellow);  2: Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSBlue);  3: Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSCyan);  else   Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSRed);  end;    Canvas.Lighting.ActiveShader := previousShader;end; procedure TBGLCheckerBoardShader.StartUse;begin  inherited StartUse;  FCanvasSize.Update;  FTime.Update;end; end. ---------------------------------------------------------------------- circular · 2024-07-04 14:32 Awesome! Everything looking great! Can you provide a repository or a zip file of the project so that we can play with it?  Warm regards ---------------------------------------------------------------------- Gigatron · 2024-07-04 15:27 Sure , all files are included except .exe on my ftp network ; http://gigatron3k.free.fr/laz/Bgra_Gl_Shader0.zip Best Regards ---------------------------------------------------------------------- circular · 2024-07-04 15:38 Hi Gigatron, I get a server error when trying to download the zip. Is it too big to attach to a message? If that's the case, I suggest to use a GitHub or GitLab account to provide a repository. ---------------------------------------------------------------------- lainz · 2024-07-04 15:45 Quote from: circular on July 04, 2024, 05:38:54 pmHi Gigatron, I get a server error when trying to download the zip. Is it too big to attach to a message? If that's the case, I suggest to use a GitHub or GitLab account to provide a repository. Try with Firefox. You can allow http downloads with it. Anyways I've uploaded this to github https://github.com/bgrabitmap/demo/releases/download/v1.0/Bgra_Gl_Shad er0.zip ---------------------------------------------------------------------- circular · 2024-07-04 23:01 Thank you very much Lainz ---------------------------------------------------------------------- Gigatron · 2024-07-05 15:20 Quote from: circular on July 04, 2024, 05:38:54 pmHi Gigatron, I get a server error when trying to download the zip. Is it too big to attach to a message? If that's the case, I suggest to use a GitHub or GitLab account to provide a repository. Quote from: circular on July 04, 2024, 05:38:54 pmHi Gigatron, I get a server error when trying to download the zip. Is it too big to attach to a message? If that's the case, I suggest to use a GitHub or GitLab account to provide a repository. Hi @circular All went well now  , sorry for delayed answer, thank you @lainz. The world of glsl or pixel shader ; One of the most beautifull shader "Seascape"  is made by Alexander Alekseev aka TDM - 2014 https://www.shadertoy.com/view/Ms2SD1 Here is the quick conversion. Main unit; ** The BGRASeascape Unit is in the next post (if not max_char is overflowed) ! Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL,BGRASeascapeShader,BGRABitmapTypes,GL; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private  seascape: TBGLSeascapeShader;  public   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin      seascape.Time:= seascape.Time +0.004;      seascape.RenderOnCanvas;end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin   seascape := TBGLSeascapeShader.Create(BGLContext.Canvas);end; procedure TForm1.Timer1Timer(Sender: TObject);begin      BGLVirtualScreen1.Repaint;end; end. ---------------------------------------------------------------------- Gigatron · 2024-07-05 15:23 Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i  [code=pascal]// SPDX-License-Identifier: LGPL-3.0-linking-exception { Checkerboard effect using OpenGL shaders }unit BGRASeascapeShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Shader computing Checkerboard }  TBGLSeascapeShader = class(TBGLShader3D)  private    function GetCanvasSize: TPointF;    procedure SetCanvasSize(AValue: TPointF);    function GetImageIndex: integer;  function GetTime: Single;    procedure SetImageIndex(AValue: integer);    procedure SetTime(AValue: Single);   protected    FCanvasSize: TUniformVariablePointF;    FImageIndex: TUniformVariableInteger;    FTime:     TUniformVariableSingle;    procedure StartUse; override;    property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;   public    constructor Create(ACanvas: TBGLCustomCanvas);    function Render(AWidth, AHeight: integer): IBGLTexture; overload;    procedure RenderOnCanvas;    property ImageIndex: integer read GetImageIndex write SetImageIndex;  property Time: Single read GetTime write SetTime;   end; implementation { TBGLSeascapeShader } function TBGLSeascapeShader.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; function TBGLSeascapeShader.GetTime: Single;begin  result := FTime.Value;end; procedure TBGLSeascapeShader.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end; function TBGLSeascapeShader.GetImageIndex: integer;begin  result := FImageIndex.Value;end;  procedure TBGLSeascapeShader.SetImageIndex(AValue: integer);begin  FImageIndex.Value := AValue;end; procedure TBGLSeascapeShader.SetTime(AValue: Single);begin    FTime.Value := AValue;end;  constructor TBGLSeascapeShader.Create(ACanvas: TBGLCustomCanvas); begin// vertex + fragmentinherited Create(ACanvas,'uniform vec2 canvasSize;'#10+'void main(void) {'#10 +'       gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +'    //texCoord = vec2(gl_MultiTexCoord0);'#10 +'    texCoord = gl_Vertex.xy / canvasSize;;'#10 +'}', 'uniform float time;'#10 +'uniform sampler2D image;'#10 +'out vec4 FragmentColor;'#10 + '/*                                                                                  '#10+' * "Seascape" by Alexander Alekseev aka TDM - 2014                                    '#10+' * License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License.  '#10+' * Contact: tdmaav@gmail.com                                                          '#10+' */                                                                                   '#10+'                                                                                      '#10+'const int NUM_STEPS = 16;                                                             '#10+'const float PI         = 3.141592;                                                    '#10+'const float EPSILON    = 1e-3;                                                        '#10+ '//#define AA                                                                          '#10+'                                                                                      '#10+'// sea                                                                              '#10+'const int ITER_GEOMETRY = 3;                                                          '#10+'const int ITER_FRAGMENT = 5;                                                          '#10+'const float SEA_HEIGHT = 0.6;                                                         '#10+'const float SEA_CHOPPY = 4.0;                                                         '#10+'const float SEA_SPEED = 3.0;                                                          '#10+'const float SEA_FREQ = 0.16;                                                          '#10+'const vec3 SEA_BASE = vec3(0.0,0.09,0.18);                                            '#10+'const vec3 SEA_WATER_COLOR = vec3(0.8,0.9,0.6)*0.8;                                     '#10+'#define SEA_TIME (1.0 + time * SEA_SPEED)                                             '#10+'const mat2 octave_m = mat2(1.6,1.2,-1.2,1.6);                                           '#10+'//                                                                                    '#10+'                                                                                      '#10+'                                                                                      '#10+'// math                                                                               '#10+'mat3 fromEuler(vec3 ang) {                                                            '#10+'       vec2 a1 = vec2(sin(ang.x),cos(ang.x));                                         '#10+'    vec2 a2 = vec2(sin(ang.y),cos(ang.y));                                            '#10+'    vec2 a3 = vec2(sin(ang.z),cos(ang.z));                                            '#10+'    mat3 m;                                                                           '#10+'    m[0] = vec3(a1.y*a3.y+a1.x*a2.x*a3.x,a1.y*a2.x*a3.x+a3.y*a1.x,-a2.y*a3.x);        '#10+'       m[1] = vec3(-a2.y*a1.x,a1.y*a2.y,a2.x);                                        '#10+'       m[2] = vec3(a3.y*a1.x*a2.x+a1.y*a3.x,a1.x*a3.x-a1.y*a3.y*a2.x,a2.y*a3.y);      '#10+'       return m;                                                                      '#10+'}'#10+'float hash( vec2 p ) {                                                                '#10+'       float h = dot(p,vec2(127.1,311.7));                                            '#10+'    return fract(sin(h)*43758.5453123);                                               '#10+'}'#10+'float noise( in vec2 p ) {                                                              '#10+'  vec2 i = floor( p );                                                              '#10+'    vec2 f = fract( p );                                                              '#10+'       vec2 u = f*f*(3.0-2.0*f);                                                      '#10+'    return -1.0+2.0*mix( mix( hash( i + vec2(0.0,0.0) ),                              '#10+'                     hash( i + vec2(1.0,0.0) ), u.x),                                   '#10+'              mix( hash( i + vec2(0.0,1.0) ),                                       '#10+'                     hash( i + vec2(1.0,1.0) ), u.x), u.y);                             '#10+'}'#10+'                                                                                      '#10+'// lighting                                                                           '#10+'float diffuse(vec3 n,vec3 l,float p) {                                                '#10+'    return pow(dot(n,l) * 0.4 + 0.6,p);                                               '#10+'}'#10+'float specular(vec3 n,vec3 l,vec3 e,float s) {                                        '#10+'    float nrm = (s + 8.0) / (PI * 8.0);                                                 '#10+'    return pow(max(dot(reflect(e,n),l),0.0),s) * nrm;                                 '#10+'}'#10+'                                                                                      '#10+'// sky                                                                                '#10+'vec3 getSkyColor(vec3 e) {                                                            '#10+'    e.y = (max(e.y,0.0)*0.8+0.2)*0.8;                                                 '#10+'    return vec3(pow(1.0-e.y,2.0), 1.0-e.y, 0.6+(1.0-e.y)*0.4) * 1.1;                  '#10+'}'#10+'                                                                                      '#10+'// sea                                                                                '#10+'float sea_octave(vec2 uv, float choppy) {                                             '#10+'    uv += noise(uv);                                                                  '#10+'    vec2 wv = 1.0-abs(sin(uv));                                                       '#10+'    vec2 swv = abs(cos(uv));                                                          '#10+'    wv = mix(wv,swv,wv);                                                              '#10+'    return pow(1.0-pow(wv.x * wv.y,0.65),choppy);                                     '#10+'}'#10+'                                                                                      '#10+'float map(vec3 p) {                                                                   '#10+'    float freq = SEA_FREQ;                                                            '#10+'    float amp = SEA_HEIGHT;                                                           '#10+'    float choppy = SEA_CHOPPY;                                                          '#10+'    vec2 uv = p.xz; uv.x *= 0.75;                                                     '#10+'                                                                                      '#10+'    float d, h = 0.0;                                                                 '#10+'    for(int i = 0; i < ITER_GEOMETRY; i++) {                                          '#10+'       d = sea_octave((uv+SEA_TIME)*freq,choppy);                                     '#10+'       d += sea_octave((uv-SEA_TIME)*freq,choppy);                                    '#10+'        h += d * amp;                                                                 '#10+'       uv *= octave_m; freq *= 1.9; amp *= 0.22;                                      '#10+'        choppy = mix(choppy,1.0,0.2);                                                 '#10+'    }                                                                                 '#10+'    return p.y - h;                                                                   '#10+'}'#10+'                                                                                      '#10+'float map_detailed(vec3 p) {                                                          '#10+'    float freq = SEA_FREQ;                                                            '#10+'    float amp = SEA_HEIGHT;                                                           '#10+'    float choppy = SEA_CHOPPY;                                                        '#10+'    vec2 uv = p.xz; uv.x *= 0.75;                                                     '#10+'                                                                                      '#10+'    float d, h = 0.0;                                                                 '#10+'    for(int i = 0; i < ITER_FRAGMENT; i++) {                                          '#10+'       d = sea_octave((uv+SEA_TIME)*freq,choppy);                                     '#10+'       d += sea_octave((uv- SEA_TIME)*freq,choppy);                                      '#10+'      h += d * amp;                                                                 '#10+'       uv *= octave_m; freq *= 1.9; amp *= 0.22;                                      '#10+'        choppy = mix(choppy,1.0,0.2);                                                 '#10+'    }                                                                                 '#10+'    return p.y - h;                                                                   '#10+'}'#10+'                                                                                    '#10+'vec3 getSeaColor(vec3 p, vec3 n, vec3 l, vec3 eye, vec3 dist) {                         '#10+'    float fresnel = clamp(1.0 - dot(n,-eye), 0.0, 1.0);                                 '#10+'    fresnel = min(pow(fresnel,3.0), 0.5);                                             '#10+'                                                                                      '#10+'    vec3 reflected = getSkyColor(reflect(eye,n));                                       '#10+'    vec3 refracted = SEA_BASE + diffuse(n,l,80.0) * SEA_WATER_COLOR * 0.12;             '#10+'                                                                                      '#10+'    vec3 color = mix(refracted,reflected,fresnel);                                    '#10+'                                                                                      '#10+'    float atten = max(1.0 - dot(dist,dist) * 0.001, 0.0);                               '#10+'    color += SEA_WATER_COLOR * (p.y - SEA_HEIGHT) * 0.18 * atten;                     '#10+'                                                                                      '#10+'    color += vec3(specular(n,l,eye,60.0));                                            '#10+'                                                                                      '#10+'    return color;                                                                     '#10+'}'#10+'                                                                                    '#10+'// tracing                                                                            '#10+'vec3 getNormal(vec3 p, float eps) {                                                     '#10+'    vec3 n;                                                                           '#10+'    n.y = map_detailed(p);                                                            '#10+'    n.x = map_detailed(vec3(p.x+eps,p.y,p.z)) - n.y;                                  '#10+'    n.z = map_detailed(vec3(p.x,p.y,p.z+eps)) - n.y;                                  '#10+'    n.y = eps;                                                                        '#10+'    return normalize(n);                                                              '#10+'}'#10+'                                                                                      '#10+'float heightMapTracing(vec3 ori, vec3 dir, out vec3 p) {                                '#10+'    float tm = 0.0;                                                                   '#10+'    float tx = 1000.0;                                                                '#10+'    float hx = map(ori + dir * tx);                                                     '#10+'  if(hx > 0.0) {                                                                    '#10+'        p = ori + dir * tx;                                                           '#10+'        return tx;                                                                    '#10+'    }                                                                                 '#10+'    float hm = map(ori + dir * tm);                                                   '#10+'    float tmid = 0.0;                                                                 '#10+'    for(int i = 0; i < NUM_STEPS; i++) {                                              '#10+'        tmid = mix(tm,tx, hm/(hm-hx));                                                '#10+'        p = ori + dir * tmid;                                                           '#10+'       float hmid = map(p);                                                           '#10+'               if(hmid < 0.0) {                                                       '#10+'               tx = tmid;                                                               '#10+'          hx = hmid;                                                                '#10+'        } else {                                                                      '#10+'            tm = tmid;                                                                '#10+'          hm = hmid;                                                                '#10+'        }                                                                             '#10+'    }                                                                                 '#10+'    return tmid;                                                                      '#10+'}'#10+  // main'void main(void)'#10 +'{'#10 +'                                                                                                '#10+'                                                                                                  '#10+'     vec2 uv = texCoord *2.-1.0;                                                           '#10+'            uv.y =1.-uv.y;'#10+'    // ray                                                                                      '#10+'    vec3 ang = vec3(sin(time*3.0)*0.1,sin(time)*0.2+0.8,time);                                 '#10+'    vec3 ori = vec3(0.0,3.5,time*5.0);                                                     '#10+'    vec3 dir = normalize(vec3(uv.xy,-2.0));                                                          '#10+'    dir = normalize(dir) * fromEuler(ang);                                                        '#10+'                                                                                                '#10+'    // tracing                                                                                    '#10+'    vec3 p;                                                                                     '#10+'    heightMapTracing(ori,dir,p);                                                                  '#10+'    vec3 dist = p - ori;                                                                          '#10+'    vec3 n = getNormal(p, dot(dist,dist) * 0.0001);                                            '#10+'    vec3 light = normalize(vec3(0.0,1.0,0.8));                                                    '#10+ '        vec3 color = mix(                                                                         '#10+'    getSkyColor(dir), getSeaColor(p, n, light, dir, dist), pow(smoothstep(0.0, -0.05, dir.y), 0.3));'#10+'                                                                                                '#10+'                                                                                                  '#10+' FragmentColor =   vec4(pow(color, vec3(0.75)), 1.0); '#10 + '}', 'varying vec2 texCoord;', '130');    FCanvasSize := UniformPointF['canvasSize']; //  FImageIndex := UniformInteger['image'];  FTime := UniformSingle['time'];      // float uniform  ImageIndex:= 0;  Time := 0;end; function TBGLSeascapeShader.Render(AWidth, AHeight: integer): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;begin  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(AWidth, AHeight);  Canvas.ActiveFrameBuffer := buf;  Canvas.Fill(BGRAPixelTransparent);  RenderOnCanvas;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;end;procedure TBGLSeascapeShader.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(Canvas.Width, Canvas.Height);  Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSYellow);  Canvas.Lighting.ActiveShader := previousShader;end;  procedure TBGLSeascapeShader.StartUse;begin  inherited StartUse;  FCanvasSize.Update;//  FImageIndex.Update;  FTime.Update;end; end.[/code] ---------------------------------------------------------------------- circular · 2024-07-05 22:46 Wow this is incredible. Just with a shader. I am out of words ---------------------------------------------------------------------- lainz · 2024-07-05 23:04 It's like chinese for me ---------------------------------------------------------------------- circular · 2024-07-06 10:51 Hi Gigatron, I've added a TBGLFullCanvasShader class (on dev branch), so that it is easier to make the shader. Here is the resulting BGRACheckerBoardGL class: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { Checkerboard effect using OpenGL shaders }unit BGRACheckerBoardGL; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Shader computing Checkerboard }  TBGLCheckerBoardShader = class(TBGLFullCanvasShader)  private    function GetTime: Single;    procedure SetTime(AValue: Single);   protected    FTime: TUniformVariableSingle;    FColor: TUniformVariableColor;    FColorNumber: Integer;    procedure StartUse; override;    function GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string; override;   public    constructor Create(ACanvas: TBGLCustomCanvas);    property Time: Single read GetTime write SetTime;    property ColorNumber: Integer read FColorNumber write FColorNumber;   end; implementation { TBGLCheckerBoardShader } function TBGLCheckerBoardShader.GetTime: Single;begin  result := FTime.Value;end; procedure TBGLCheckerBoardShader.SetTime(AValue: Single);begin  FTime.Value := AValue;end; constructor TBGLCheckerBoardShader.Create(ACanvas: TBGLCustomCanvas);begin  inherited Create(ACanvas);  FTime := UniformSingle['time'];      // float uniform  FColor := UniformColor['color'];     // color uniform   ColorNumber := -1;  // no coloring by default  Time := 0;end; procedure TBGLCheckerBoardShader.StartUse;begin  inherited StartUse;  FTime.Update;   // setup custom color variable  Case ColorNumber of  0: FColor.Value := CSSRed.ToColorF(false);    1: FColor.Value := CSSYellow.ToColorF(false);    2: FColor.Value := CSSBlue.ToColorF(false);    3: FColor.Value := CSSCyan.ToColorF(false);  else    FColor.Value := BGRAWhite.ToColorF(false);  end;  FColor.Update;end; function TBGLCheckerBoardShader.GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string;begin  result :=  'uniform float time;'#10 +  // custom color uniform variable is different from the input color from the vertices  'uniform vec4 color;'#10 +   'void main(void)'#10 +  '{'#10 +  ' vec2 pos = '+AInputCoord+' - vec2(0.5,0.5);     '#10 +  ' float horizon = 0.0;  '#10 +  ' float fov = 0.5;      '#10 +  ' float scaling = 0.4;  '#10 +  ' vec3 p = vec3(pos.x, fov, pos.y - horizon);'#10 +  ' vec2 s = vec2(p.x/p.z, p.y/p.z) * scaling; '#10 +  ' float f = 1.0;                           '#10 +  ' //checkboard                               '#10 +  ' float col = sign((mod(s.x*f+cos(time*0.3), 0.1*f) - 0.05) * (mod(s.y*f+sin(time*0.2), 0.1*f) - 0.05));'#10 +  ' col *= p.z*p.z*5.0*(1.0 - abs(p.x));'#10 +   ' '+AOutputColor+' = vec4(col, col, col, 1.0) * '+AInputColor+' * color; '#10 +  '}';end; end. And in the main form, I've adapted the code to scale with the window: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGRABitmapTypes, BGLVirtualScreen, BGRAOpenGL,  BGRASeascapeShader, BGRACheckerBoardGL,  mmsystem; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;    BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    gtr_logo  : IBGLTexture;    logo_xpos : integer;    FChecker: TBGLCheckerBoardShader;     MainFont: IBGLFont;    line_message :Array of PChar;    LineXpos,   LineYpos, bounce,fct  : Single;    // color select    C_color : integer;     // dot plot    s,a,ag : single;    alfa,alfa_time,plot_dir,p_x : integer;     FWavStream : TMemoryStream;  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  MainFont := BGLFont('AmigaParadox',60);   SetLength(line_message, 1);  line_message[0] :=  (' HELLO  GIGATRON BEYOND THE SUB - QUANTUM PRESENTS BGRA CHECKERBOARD GL FRAGMENT SHADER DEMO. CODED WITH LAZARUS FPC USING BGRA COMPONENT THANX TO CIRCULAR WHO INCLUDED GLSL SHADER -  SFX : 16-BEAT / RAZOR 1911 SEE YOU ON NEXT PRODUCTION ........');  LineXPos := 2800;  LineYpos := 460;  bounce := 0.0;  fct    := 0.0;  // plot fx  s := 255/sqrt(3)*2/30;  a := 0.0;  p_x := -1400;  // angle  ag := 0.0;  alfa :=0;  // logo x pos  logo_xpos:= -800;  // checker color  C_color :=0;   // audio stream  FWavStream    := TMemoryStream.Create;  FWavStream.LoadFromFile('itspheno.wav');  PlaySound(FWavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY);   BGLVirtualScreen1.Align := alClient;end; procedure TForm1.FormDestroy(Sender: TObject);begin  PlaySound(nil, 0, 0);  FWavStream.Free;end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);var  i : integer;  xx,yy : integer;  r,z,x1,x2,y1,y2 : single; begin   FChecker.Time:= FChecker.Time +0.030;  FChecker.ColorNumber := C_color;  FChecker.RenderOnCanvas;   BGLContext.Canvas.Scale(BGLContext.Canvas.Width / 744, BGLContext.Canvas.Height / 520);   BGLContext.Canvas.PutImage(logo_xpos,0, gtr_logo,alfa);    // plot fx  for xx:=15 downto -15 do   begin     for yy:=15 downto -15 do      begin        r := (sqrt(xx*xx+yy*yy))+2;       z := 40*sin(r+a*0.6)/r*0.8;        x2 := xx*cos(a*PI/180)-yy*sin(ag*PI/180);       y2 := xx*sin(a*PI/180)+yy*cos(ag*PI/180);        x1 := round(360+(y2-x2)*s*sqrt(3)/2);       y1 := round(300+z-(y2+x2)*s/2);       BgLContext.Canvas.Arc(x1+p_x,y1,2,2,0,360,BGRA(alfa,alfa,alfa),fa lse,BGRA(180,180,180));       end;   end;    ag := ag - 0.1;     for  i := 0 to  Length(line_message[0])-1 do  begin   if LinexPos < -Length(line_message[0]) * 30  then   begin   LinexPos := 800;   end;   LinexPos := LineXPos - 0.012;   LineyPos := 460;   MainFont.TextOut(i * 30  + LinexPos+4,LineYPos-50*abs(sin(bounce)*2)+2 , line_message[0][i],BGRA(255,255,255));   MainFont.TextOut(i * 30  + LinexPos,LineYPos-50*abs(sin(bounce)*2) , line_message[0][i],BGRA(20,120,255));  end;   bounce := bounce + 0.04;    if(plot_dir=1) then  a := a + 0.2;  if(plot_dir=2) then  a := a - 0.2;end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  gtr_logo := BGLTexture(ResourceFile('phex.png'));  FChecker := TBGLCheckerBoardShader.Create(BGLContext.Canvas);end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  gtr_logo   := nil;  FreeAndNil(FChecker);end; procedure TForm1.Timer1Timer(Sender: TObject);begin  inc(alfa_time);  if(alfa_time>300+Random(600)) then  begin    alfa_time :=0;    plot_dir := 1+Random(2);    C_color := C_color + 1;    if(C_color>=4) then C_color:=0;  end;   inc(logo_xpos,5);  if(logo_xpos>=30) then  begin  inc(alfa);  if (alfa>=250) then alfa :=250;  logo_xpos :=30;  end;   inc(p_x,20);  if(p_x>=20) then p_x :=20;   BGLVirtualScreen1.Invalidate;end; end. Quote from: lainz on July 06, 2024, 01:04:44 amIt's like chinese for me  Yes, this seascape is quite complex. The simpler shader is easier to understand. ---------------------------------------------------------------------- Gigatron · 2024-07-08 12:50 Goood  !! Thank you @circular , will test the code a.s.a.p for new shader. Best regards GTR ---------------------------------------------------------------------- Gigatron · 2024-07-08 13:55 Ok, @circular , here is another quick conversion based on your code ; the conversion take less time now ** TBGLFullCanvasShader class (on dev branch) Point Tunnel Shader from Flyguy https://www.shadertoy.com/view/Xlt3R8 Projet is atached for playing with; Main unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL,BGRADefaultShader,BGRABitmapTypes,GL; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private  dot_tunnel: TBGLDefaultShader;  public   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin      // nothing hereend; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin     dot_tunnel.Time:= dot_tunnel.Time +0.014;     dot_tunnel.RenderOnCanvas;end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin    dot_tunnel := TBGLDefaultShader.Create(BGLContext.Canvas);end; procedure TForm1.Timer1Timer(Sender: TObject);begin   BGLVirtualScreen1.Invalidate;end; end.  Shader unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { DefaultShader for any OpenGL shaders }unit BGRADefaultShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Shader computing Checkerboard }  TBGLDefaultShader = class(TBGLFullCanvasShader)  private   private    function GetTime: Single;    procedure SetTime(AValue: Single);   protected    FTime: TUniformVariableSingle;    procedure StartUse; override;    function GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string; override;   public    constructor Create(ACanvas: TBGLCustomCanvas);    property Time: Single read GetTime write SetTime;   end; implementation  { TBGLDefaultShader } function TBGLDefaultShader.GetTime: Single;begin  result := FTime.Value;end; procedure TBGLDefaultShader.SetTime(AValue: Single);begin  FTime.Value := AValue;end; constructor TBGLDefaultShader.Create(ACanvas: TBGLCustomCanvas);begin  inherited Create(ACanvas);  FTime := UniformSingle['time'];      // float uniform   Time := 0;end; procedure TBGLDefaultShader.StartUse;begin  inherited StartUse;  FTime.Update; end; function TBGLDefaultShader.GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string;begin  result := 'uniform float time;'#10+ '//Constants                          '#10 + '#define TAU 6.2831853071795865       '#10 + '//Parameters                       '#10 + '#define TUNNEL_LAYERS 64             '#10 + '#define RING_POINTS 128              '#10 + '#define POINT_SIZE 1.8             '#10 + '#define POINT_COLOR_A vec3(1.0)      '#10 + '#define POINT_COLOR_B vec3(0.7)      '#10 + '#define SPEED 0.8                  '#10 + '//Square of x                                                                              '#10+'float sq(float x)                                                                          '#10+'{                                                                                        '#10+'       return x*x;                                                                         '#10+'}                                                                                        '#10+'                                                                                           '#10+'//Angular repeat                                                                           '#10+'vec2 AngRep(vec2 uv, float angle)                                                          '#10+'{                                                                                          '#10+'    vec2 polar = vec2(atan(uv.y, uv.x), length(uv));                                       '#10+'    polar.x = mod(polar.x + angle / 2.0, angle) - angle / 2.0;                               '#10+'                                                                                           '#10+'  return polar.y * vec2(cos(polar.x), sin(polar.x));                                     '#10+'}                                                                                          '#10+'                                                                                         '#10+'//Signed distance to circle                                                                '#10+'float sdCircle(vec2 uv, float r)                                                             '#10+'{                                                                                          '#10+'    return length(uv) - r;                                                                 '#10+'}                                                                                        '#10+'                                                                                           '#10+'//Mix a shape defined by a distance field sd with a target color using the fill       color. '#10+'vec3 MixShape(float sd, vec3 fill, vec3 target)                                            '#10+'{                                                                                          '#10+'    float blend = smoothstep(0.0,1.0/1000.0, sd);                                          '#10+'    return mix(fill, target, blend);                                                       '#10+'}                                                                                        '#10+'                                                                                           '#10+'//Tunnel/Camera path                                                                       '#10+'vec2 TunnelPath(float x)                                                                   '#10+'{                                                                                          '#10+'    vec2 offs = vec2(0, 0);                                                                '#10+'                                                                                           '#10+'    offs.x = 0.2 * sin(TAU * x * 0.5) + 0.4 * sin(TAU * x * 0.2 + 0.3);                      '#10+'  offs.y = 0.3 * cos(TAU * x * 0.3) + 0.2 * cos(TAU * x * 0.1);                          '#10+'                                                                                           '#10+'    offs *= smoothstep(1.0,4.0, x);                                                        '#10+'                                                                                           '#10+'    return offs;                                                                           '#10+'}                                                                                          '#10+    'void main(void)'#10 +  '{'#10 +  ' vec2 uv = '+AInputCoord+' -0.5 ;     '#10 + ' vec3 color = vec3(0);  '#10 +'float repAngle = TAU / float(RING_POINTS);                                            '#10+'float pointSize = POINT_SIZE/2.0/500.0;                                         '#10+'                                                                                    '#10+'float camZ = time * SPEED;                                                           '#10+'vec2 camOffs = TunnelPath(camZ);                                                      '#10+'                                                                                      '#10+'for(int i = 1;i <= TUNNEL_LAYERS;i++)                                                 '#10+'{                                                                                   '#10+'    float pz = 1.0 - (float(i) / float(TUNNEL_LAYERS));                               '#10+'                                                                                      '#10+'    //Scroll the points towards the screen                                              '#10+'    pz -= mod(camZ, 4.0 / float(TUNNEL_LAYERS));                                      '#10+'                                                                                      '#10+'    //Layer x/y offset                                                                '#10+'    vec2 offs = TunnelPath(camZ + pz) - camOffs;                                      '#10+'                                                                                      '#10+'    //Radius of the current ring                                                      '#10+'    float ringRad = 0.15 * (1.0 / sq(pz * 0.8 + 0.4));                                '#10+'                                                                                      '#10+'    //Only draw points when uv is close to the ring.                                  '#10+'    if(abs(length(uv + offs) - ringRad) < pointSize * 1.5)                            '#10+'    {                                                                                 '#10+'        //Angular repeated uv coords                                                    '#10+'        vec2 aruv = AngRep(uv + offs, repAngle);                                      '#10+'                                                                                      '#10+'        //Distance to the nearest point                                               '#10+'        float pdist = sdCircle(aruv - vec2(ringRad, 0), pointSize);                     '#10+'                                                                                      '#10+'      //Stripes                                                                     '#10+'        vec3 ptColor = (mod(float(i / 2), 2.0) == 0.0) ? POINT_COLOR_A : POINT_COLOR_B; '#10+'                                                                                      '#10+'      //Distance fade                                                               '#10+'        float shade = (1.0-pz);                                                       '#10+'                                                                                      '#10+'      color = MixShape(pdist, ptColor * shade, color);                              '#10+'    }                                                                                 '#10+'}                                                                                     '#10+ ' '+AOutputColor+' = vec4(color, 1.0)  ; '#10 +'}';end; end. ---------------------------------------------------------------------- Gigatron · 2024-07-09 15:26 Hi , here is another shader example called resolution shader ; programmed under 1 hour like always ; The goal is to interact with uniform variables with spinners ; @circular thank you again, btw are you planning to update BGRA to include TBGLFullCanvasShader class (on dev branch) ? Main Unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,  BGLVirtualScreen, BGRAOpenGL,BGRADefaultShader,BGRABitmapTypes,GL; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    FloatSpinEdit1: TFloatSpinEdit;    FloatSpinEdit2: TFloatSpinEdit;    FloatSpinEdit3: TFloatSpinEdit;    FloatSpinEdit4: TFloatSpinEdit;    FloatSpinEdit5: TFloatSpinEdit;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);  procedure Timer1Timer(Sender: TObject);  private  rez_shader: TBGLDefaultShader;  public    tex  : IBGLTexture;  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin      // nothing hereend; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin     rez_shader.Time:= rez_shader.Time +0.014;     rez_shader.ImageIndex:= 0;     rez_shader.Rezolution := FloatSpinEdit1.Value;     rez_shader.Scale:= FloatSpinEdit2.Value;    rez_shader.Red  := FloatSpinEdit3.Value;     rez_shader.Green:= FloatSpinEdit4.Value;     rez_shader.Blue := FloatSpinEdit5.Value;    rez_shader.RenderOnCanvas;end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin    rez_shader := TBGLDefaultShader.Create(BGLContext.Canvas);    tex        := BGLTexture(ResourceFile('girls.png'));end; procedure TForm1.Timer1Timer(Sender: TObject);begin   BGLVirtualScreen1.Invalidate;end; end.  Second shader unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { DefaultShader for any OpenGL shaders }unit BGRADefaultShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Shader computing rez shader  }  TBGLDefaultShader = class(TBGLFullCanvasShader)  private    protected    FTime: TUniformVariableSingle;    FTimer : Single;     FImageIndex: TUniformVariableInteger;    FImage_idx : integer;     FRez: TUniformVariableSingle;    FRezolution : Single;     FScale  : TUniformVariableSingle;    FScalev : Single;    // rgb    FRed  : TUniformVariableSingle;    FRedv : Single;     FGreen  : TUniformVariableSingle;    FGreenv : Single;     FBlue  : TUniformVariableSingle;    FBluev : Single;       procedure StartUse; override;    function GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string; override;   public    constructor Create(ACanvas: TBGLCustomCanvas);    // propriete lecture ecriture des uniforms    property Time: Single read FTimer write FTimer;    property ImageIndex: integer read FImage_idx write FImage_idx;     property Rezolution:  Single read FRezolution write FRezolution;    property Scale:  Single read FScalev write FScalev;  // rgb    property Red  :  Single read FRedv write FRedv;    property Green:  Single read FGreenv write FGreenv;    property Blue :  Single read FBluev write FBluev;      end; implementation  { TBGLDefaultShader }  constructor TBGLDefaultShader.Create(ACanvas: TBGLCustomCanvas);begin  inherited Create(ACanvas);  FTime := UniformSingle['time'];      // float uniform  FRez := UniformSingle['rez'];  FScale := UniformSingle['scale'];  FImageIndex := UniformInteger['image'];  FRed   := UniformSingle['red'];  FGreen := UniformSingle['green'];  FBlue  := UniformSingle['blue'];    FImage_idx:= 0;  FTimer := 0;end; procedure TBGLDefaultShader.StartUse;begin  inherited StartUse;  FTime.Update;  FImageIndex.Update;  FRez.Update;  // set values to uniforms  FTime.Value:=FTimer;  FRez.Value := FRezolution;  FScale.Value:= FScalev;   FRed.Value   := FRedv;  FGreen.Value := FGreenv;  FBlue.Value  := FBluev;end; function TBGLDefaultShader.GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string;begin  result := 'uniform float time;'#10+ 'uniform float rez;'#10+ 'uniform float scale;'#10+ 'uniform sampler2D image;'#10 + '///  RGB '#10+ 'uniform float red;'#10+ 'uniform float green;'#10+ 'uniform float blue;'#10+    'void main(void)'#10 +  '{'#10 +  ' vec2 p = '+AInputCoord+'  ;     '#10 +   'p = floor(rez*p)/rez;'#10+  'float x = 640.0*(p.y);'#10+  ''#10+   'float cop = time*4.0;'#10+  ' vec3 color = vec3( 0.5 + 0.5 * sin(x/scale + red - cop), 0.5 + 0.5 * cos (x/scale + green - cop), 0.5 + 0.5 * cos (x/scale + blue - cop));    '#10 +' vec3 tx = texture2D(image,p/vec2(1.3,1.8)).xyz;'#10+  ' '+AOutputColor+' = vec4(tx*(color*1.4)   , 1.0) ; '#10 +'}';end; end. ---------------------------------------------------------------------- Gigatron · 2024-07-09 23:44 Hi, And after this you can make a million of different fx with pixel shaders like this one ; Send the example on YT quickly; https://www.youtube.com/watch?v=RlF0pEJtjGE Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls, BGLVirtualScreen, BGRAOpenGL, BGRADefaultShader, BGRABitmapTypes,  GL,mmsystem; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    CheckBox1: TCheckBox;    FloatSpinEdit1: TFloatSpinEdit;    FloatSpinEdit2: TFloatSpinEdit;    FloatSpinEdit3: TFloatSpinEdit;    FloatSpinEdit4: TFloatSpinEdit;    FloatSpinEdit5: TFloatSpinEdit;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private  rez_shader: TBGLDefaultShader;  FWavStream : TMemoryStream;  public    tex  : IBGLTexture;  end; var  Form1: TForm1;  r_md : single; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin      r_md :=0;      // audio stream  FWavStream    := TMemoryStream.Create;  FWavStream.LoadFromFile('outlander.wav');  PlaySound(FWavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY); end; procedure TForm1.FormDestroy(Sender: TObject);begin  PlaySound(nil, 0, 0);  FWavStream.Free;end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin     rez_shader.Time:= rez_shader.Time +0.014;     rez_shader.ImageIndex:= 0;     rez_shader.Rezolution := FloatSpinEdit1.Value;     rez_shader.Scale:= FloatSpinEdit2.Value;    rez_shader.Red  := FloatSpinEdit3.Value;     rez_shader.Green:= FloatSpinEdit4.Value;     rez_shader.Blue := FloatSpinEdit5.Value;    rez_shader.RainbowMode :=r_md;      rez_shader.RenderOnCanvas;end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  tex   := nil;  FreeAndNil(rez_shader);end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin    rez_shader := TBGLDefaultShader.Create(BGLContext.Canvas);    tex        := BGLTexture(ResourceFile('louie.png'));end; procedure TForm1.Timer1Timer(Sender: TObject);begin   if(CheckBox1.Checked) then r_md := 1.0   else   r_md := 0.0;   BGLVirtualScreen1.Invalidate;end; end.  Shader unit Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { DefaultShader for any OpenGL shaders }unit BGRADefaultShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Shader computing rez shader  }  TBGLDefaultShader = class(TBGLFullCanvasShader)  private    protected    FTime: TUniformVariableSingle;    FTimer : Single;     FImageIndex: TUniformVariableInteger;    FImage_idx : Integer;     F_RainMode  : TUniformVariableSingle;    F_RainModev : single;      FRez: TUniformVariableSingle;    FRezolution : Single;     FScale  : TUniformVariableSingle;    FScalev : Single;    // rgb    FRed  : TUniformVariableSingle;    FRedv : Single;     FGreen  : TUniformVariableSingle;    FGreenv : Single;     FBlue  : TUniformVariableSingle;    FBluev : Single;       procedure StartUse; override;    function GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string; override;   public    constructor Create(ACanvas: TBGLCustomCanvas);    // propriete lecture ecriture des uniforms    property Time: Single read FTimer write FTimer;    property ImageIndex: integer read FImage_idx write FImage_idx;     property RainbowMode: single read F_RainModev write F_RainModev;     property Rezolution:  Single read FRezolution write FRezolution;    property Scale:  Single read FScalev write FScalev;  // rgb    property Red  :  Single read FRedv write FRedv;    property Green:  Single read FGreenv write FGreenv;    property Blue :  Single read FBluev write FBluev;      end; implementation  { TBGLDefaultShader }  constructor TBGLDefaultShader.Create(ACanvas: TBGLCustomCanvas);begin  inherited Create(ACanvas);  FTime := UniformSingle['time'];      // float uniform  FRez := UniformSingle['rez'];  FScale := UniformSingle['scale'];  FImageIndex := UniformInteger['image'];  FRed   := UniformSingle['red'];  FGreen := UniformSingle['green'];  FBlue  := UniformSingle['blue'];  // rainbow mode 0/1  F_RainMode := UniformSingle['r_mode'];   FImage_idx:= 0;  FTimer := 0;  RainbowMode :=0;end; procedure TBGLDefaultShader.StartUse;begin  inherited StartUse;  FTime.Update;  FImageIndex.Update;  FRez.Update;  // set values to uniforms  FTime.Value:=FTimer;  FRez.Value := FRezolution;  FScale.Value:= FScalev;   FRed.Value       := FRedv;  FGreen.Value     := FGreenv;  FBlue.Value      := FBluev;  F_RainMode.Value := F_RainModev; end; function TBGLDefaultShader.GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string;begin  result := 'uniform float time;'#10+ 'uniform float rez;'#10+ 'uniform float scale;'#10+ 'uniform sampler2D image;'#10 + '///  RGB '#10+ 'uniform float red;'#10+ 'uniform float green;'#10+ 'uniform float blue;'#10+ 'uniform float r_mode;'#10+   'void main(void)'#10 +  '{'#10 +  ' vec2 p = '+AInputCoord+'  ;     '#10 +   'p = floor(rez*p)/rez;'#10+  'float x = 640.0*(p.y);'#10+  ''#10+   'float cop = time*4.0;'#10+  ' vec3 color = vec3( 0.5 + 0.5 * sin(x/scale + red - cop), 0.5 + 0.5 * cos (x/scale + green - cop), 0.5 + 0.5 * cos (x/scale + blue - cop));    '#10 +' vec3 tx = texture2D(image,p/vec2(1.6,1.0)).xyz;'#10+' if(r_mode==0.0)'#10+'{'#10+' ' +AOutputColor+' = vec4(tx, 1.0);'#10+'}'#10+ ' if(r_mode==1.0)'#10+'{'#10+' ' +AOutputColor+' = vec4(tx+(color+(tx.r*tx.g*tx.b))/2.0 , 1.0);'#10+'}'#10+ '}';end; end. ---------------------------------------------------------------------- circular · 2024-07-10 22:15 Hi Gigatron, I am not home, but passing by and well seems that shaders open up limitless possibilities! ---------------------------------------------------------------------- Gigatron · 2024-07-14 06:35 Hi, Here a video of mixed shaders with BGRA component one with starfield and other with texture display on the same BGLscreen ; Enjoy ; https://www.youtube.com/watch?v=8hn1dtAGEMA ---------------------------------------------------------------------- circular · 2024-07-15 16:21 Very nice indeed! ---------------------------------------------------------------------- Gigatron · 2024-07-15 17:14 Quote from: circular on July 15, 2024, 06:21:54 pmVery nice indeed! Thank you @circular Since we lost the football match I no longer feel good So let's start another projet based on an old shader i ve made , gradient map or color map; here is the quickly coded source: Gfx pic from (Mosterv) Edit : Work nice with colorpicker selector now : Main unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Buttons, BGLVirtualScreen, BGRAOpenGL, BGRACMapShader, BGRABitmapTypes,  BGRAGraphicControl; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Button1: TButton;    Button2: TButton;    Button3: TButton;    CheckBox1: TCheckBox;    CheckBox2: TCheckBox;    ColorDialog1: TColorDialog;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure Button1Click(Sender: TObject);    procedure Button2Click(Sender: TObject);    procedure Button3Click(Sender: TObject);     procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private     cmap_shader: TBGLCMapShader;   public   tex,gl_surface  : IBGLTexture;   debug_mode,cmap_on : single;   rred,rgreen,rblue : TColor;   gred,ggreen,gblue : TColor;   bred,bgreen,bblue : TColor;   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin    debug_mode := 0.0;    cmap_on    := 0.0;end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));    tex     := BGLTexture(ResourceFile('mosterv.png'));    cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin    // le traitement du sampler2D comme texture     cmap_shader.ImageIndex:= 0;     cmap_shader.Debug:=debug_mode;     cmap_shader.Cmap:= cmap_on;     cmap_shader.RedColor   := BGRA(rred,rgreen,rblue).ToColorF(false);     cmap_shader.GreenColor := BGRA(gred,ggreen,gblue).ToColorF(false);     cmap_shader.BlueColor  := BGRA(bred,bgreen,bblue).ToColorF(false);     gl_surface := cmap_shader.Render(tex);        // container de l'image affichee par le shader     BGLContext.Canvas.PutImage(0,0, gl_surface,BGRA(255,255,255,255)); // le shader surface end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  tex   := nil;  gl_surface := nil;  FreeAndNil(cmap_shader);end; procedure TForm1.Button1Click(Sender: TObject);  var  SelectedColor: TColor;  RedComponent: Byte;  GreenComponent : Byte;  BlueComponent : Byte; begin   if ColorDialog1.Execute then    SelectedColor := ColorDialog1.Color;    RedComponent := Red(SelectedColor);    GreenComponent := Green(SelectedColor);    BlueComponent := Blue(SelectedColor);     rred    := RedComponent;    rgreen  := GreenComponent;    rblue   := BlueComponent ;  end; procedure TForm1.Button2Click(Sender: TObject);  var   SelectedColor: TColor;   RedComponent: Byte;   GreenComponent : Byte;   BlueComponent : Byte;  begin    if ColorDialog1.Execute then   SelectedColor := ColorDialog1.Color;     RedComponent := Red(SelectedColor);     GreenComponent := Green(SelectedColor);     BlueComponent := Blue(SelectedColor);      gred    := RedComponent;   ggreen  := GreenComponent;     gblue   := BlueComponent ; end; procedure TForm1.Button3Click(Sender: TObject);  var    SelectedColor: TColor;    RedComponent: Byte;    GreenComponent : Byte;    BlueComponent : Byte;   begin     if ColorDialog1.Execute then      SelectedColor := ColorDialog1.Color;      RedComponent := Red(SelectedColor);      GreenComponent := Green(SelectedColor);      BlueComponent := Blue(SelectedColor);       bred    := RedComponent;    bgreen  := GreenComponent;      bblue   := BlueComponent ; end; procedure TForm1.FormDestroy(Sender: TObject);begin end; procedure TForm1.Timer1Timer(Sender: TObject);begin    // debug draw gradient color     if(CheckBox1.Checked) then debug_mode :=1.0     else     debug_mode := 0.0;      if(CheckBox2.Checked) then cmap_on :=1.0     else     cmap_on := 0.0;      BGLVirtualScreen1.Invalidate;end; end.   Cmap shader unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { Colormap OpenGL shader }unit BGRACMapShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { ColorMap Shader computing rez shader  }  TBGLCMapShader = class(TBGLShader3D)   private   protected    FTime: TUniformVariableSingle;    FTimer : Single;     FImageIndex: TUniformVariableInteger;    FImage_idx : Integer;     FDebug: TUniformVariableSingle;    FDebugV : Single;     FCmap : TUniformVariableSingle;    FCmapV : Single;      // colors    FRColor: TUniformVariableColor;    FRColorV : TColorF;     FGColor: TUniformVariableColor;    FGColorV : TColorF;     FBColor: TUniformVariableColor;    FBColorV : TColorF;     procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;    // propriete lecture ecriture des uniforms    property Time: Single read FTimer write FTimer;    property ImageIndex: integer read FImage_idx write FImage_idx;     property RedColor : TColorF read FRColorV write FRColorV;    property GreenColor : TColorF read FGColorV write FGColorV;    property BlueColor : TColorF read FBColorV write FBColorV;     property Debug:  Single read FDebugV write FDebugV;     property Cmap:  Single read FCmapV write FCmapV;     end; implementation { TBGLCMapShader } constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas); begin// vertex + fragmentinherited Create(ACanvas,'void main(void) {'#10 +'    gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +'    texCoord = vec2(gl_MultiTexCoord0);'#10 +'}', 'out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform float dbg;'#10+'uniform sampler2D image;'#10+'uniform float demo_mode;'#10+'uniform float c_map;'#10+ 'uniform vec4 r_color;'#10 +'uniform vec4 g_color;'#10 +'uniform vec4 b_color;'#10 + '// G Map        '#10+'vec3 gmixer(vec3 c1, vec3 c2, vec3 c3, float g)'#10+'{'#10+'     vec3 fmx = mix(c1, c3, g);             '#10+'     float u = 1.0 - abs(g * 2.0 - 1.0);    '#10+'     fmx = mix(fmx, c2, u);                 '#10+'   return fmx;                              '#10+'}   '#10+   'void main(void)'#10 +'{'#10 +'vec2 p = texCoord ;     '#10+// flip y'p.y = 1.-p.y;'#10+'//p = floor(256.0*p)/256.0;'#10+ // depuis qu'on a perdu au foot j'ai plus la peche !!! 'vec4 tex = texture2D(image,p);'#10+'float l = dot(tex.rgb, vec3(0.299, 0.587, 0.114));'#10+ 'vec3 c1 = vec3(r_color);'#10+'vec3 c2 = vec3(g_color);'#10+'vec3 c3 = vec3(b_color);'#10+ 'vec4 map  = vec4(0.0,0.0,0.0,1.0);'#10+'map = vec4(mix(tex.xyz,gmixer(c1, c2, c3, l),1.0),1.0);'#10+ 'if(c_map != 0.0 )'#10+'FragmentColor = vec4(map);'#10+'else'#10+'FragmentColor = vec4(tex);'#10+ // debug gradient'if(dbg != 0.0 )'#10+'{'#10+'   if(p.y > 0.90){'#10+'    FragmentColor = vec4( gmixer(c1, c2, c3, 2.*p.x-0.3 ) , 1.0);'#10+' }'#10+'}'#10+ '}', 'varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  FDebug := UniformSingle['dbg'];  FCmap := UniformSingle['c_map'];   FImageIndex := UniformInteger['image'];   FRColor := UniformColor['r_color'];  FGColor := UniformColor['g_color'];  FBColor := UniformColor['b_color'];   FImage_idx:= 0;  FTimer := 0;  FDebugV :=1.0;end;  procedure TBGLCMapShader.StartUse;begin  inherited StartUse;  FTime.Update;  FImageIndex.Update;   // set values to uniforms  FTime.Value:=FTimer;  // FRColor.Update;  FRColor.Value:=FRColorV; // FGColor.Update;  FGColor.Value:=FGColorV; // FBColor.Update;  FBColor.Value:=FBColorV;  // Debug pour montrer le gradien //  FDebug.Update;   FDebug.Value:= FDebugV;    FCmap.Value:= FCmapV; end; function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;  Canvas.Fill(BGRAPixelTransparent);  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;end; end. ---------------------------------------------------------------------- circular · 2024-07-15 19:45 I sympathize with your sadness. And I understand how programming can be comforting.    I am somehow happy for the winners anyway. ---------------------------------------------------------------------- Gigatron · 2024-07-17 20:24 Hi, Let's share another nice shader; Live version on construct2 version : http://gigatron3k.free.fr/html5/C2/FX/dispersion/ Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Buttons, Spin, BGLVirtualScreen, BGRAOpenGL, BGRACMapShader, BGRABitmapTypes; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    FloatSpinEdit1: TFloatSpinEdit;    FloatSpinEdit2: TFloatSpinEdit;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    cmap_shader: TBGLCMapShader;  public   texture,gl_surface : IBGLTexture;   fnt : IBGLFont;  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin   fnt := BGLFont('Arial',30);end;  procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext); begin    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));    texture     := BGLTexture(ResourceFile('girl5.png'));    cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas); end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin    // le traitement du sampler2D comme texture   // cmap_shader.ImageIndex:= 0;     gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader     cmap_shader.Render(texture);     BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image de miss marvel     fnt.TextOut(160,560,'BGRA GL DISPERSION SHADER');end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  // libere et vire tout !!   texture    := nil;  gl_surface := nil;  FreeAndNil(cmap_shader);end;  procedure TForm1.FormDestroy(Sender: TObject);begin end; procedure TForm1.Timer1Timer(Sender: TObject);begin    cmap_shader.Time   := cmap_shader.Time + FloatSpinEdit1.value/1000;    cmap_shader.Factor := FloatSpinEdit2.value;    BGLVirtualScreen1.Invalidate;end; end.  Modifyed CMAP shader Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { Hue X/Y Shift OpenGL shader }unit BGRACMapShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Hue X/Y Shift Shader computing shader  }  TBGLCMapShader = class(TBGLShader3D)   private   function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    FTime: TUniformVariableSingle;    FTimer : Single;     FFact: TUniformVariableSingle;    FFactV : Single;     FImageIndex: TUniformVariableInteger;    FImage_idx : Integer;     FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;     procedure RenderOnCanvas;    // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Factor: Single read FFactV write FFactV;     property ImageIndex: integer read FImage_idx write FImage_idx;    property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;   end; implementation function TBGLCMapShader.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLCMapShader } constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas); begin// vertex + fragmentinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +'  gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +'  texCoord = vec2(gl_MultiTexCoord0);'#10 +'}', '#define PI 3.141592653589793238'#10+'out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform float fct;'#10+'uniform sampler2D image;'#10+ 'void main()'#10 +'{'#10 +'vec2 uv =  texCoord.xy   ;                                   '#10+// flip y'   uv.y = 1.-uv.y;                                           '#10+// resolution down'uv = floor(512.0*uv)/512.0;'#10+// move texture'vec2  xy = vec2(0.01,0.40);'#10+ 'vec4 d,p = gl_FragColor- gl_FragColor;'#10+'for(float i = 0.; i < 10.0; i++) {                                            '#10+'  p = vec4(i/10.,6.8*pow((1.0-i/10.)*i/10.0,1.5),1.-i/10.,1);                 '#10+'  d += p*p;                                                                   '#10+'  vec2 m = vec2(.05,.3);                                                      '#10+'  gl_FragColor += p*p*texture2D(image, uv-xy+i/10.*.05*(pow(sin(uv*10.0+3.*time),   '#10+'  vec2(3.))+fct*texture2D(image, uv-xy).xy-.2));                           '#10+'}                                                                       '#10+'   gl_FragColor = smoothstep(0.,1.,gl_FragColor/d);'#10+  '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  FFact := UniformSingle['fct']; ;   FImageIndex := UniformInteger['image'];  FCanvasSize := UniformPointF['canvasSize'];  FImage_idx:= 0;  FTimer := 0;  FFactV := 0;end; procedure TBGLCMapShader.StartUse;begin  inherited StartUse;  FTime.Update;  FTime.Value:=FTimer;  FImageIndex.Update;  // set values to uniforms   FFact.Update;  FFact.Value:= FFactV;  FCanvasSize.Update; end; function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;  Canvas.Fill(BGRAPixelTransparent);  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;   // canvas renderer  //previousBuf := Canvas.ActiveFrameBuffer;  //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  //Canvas.ActiveFrameBuffer := buf;  //Canvas.Fill(BGRAPixelTransparent);  //RenderOnCanvas;  //Canvas.ActiveFrameBuffer := previousBuf;  //result := buf.MakeTextureAndFree; end; procedure TBGLCMapShader.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(800,600);  Canvas.FillRect(0, 0, 800,600, CSSWhite);  Canvas.Lighting.ActiveShader := previousShader;end;end. * Edit ; just add x_displacement instead XY ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i '  gl_FragColor += p*p*texture2D(image, uv- xy+i/10.*.05*(pow(sin(uv*10.0+3.*time),   '#10+'  vec2(3.))+fct*texture2D(image, uv-xy).xy-.2));                           '#10+ // replace it with '  gl_FragColor += p*p*texture2D(image, uv-xy+i/10.*.05*(pow(sin(uv*10.0+3.*time),   '#10+'  vec2(3.))-vec2(fct,0.0)*texture2D(image, uv-xy).xy-.2));                           '#10+ ---------------------------------------------------------------------- Gigatron · 2024-07-18 21:48 Hi Another nice Shader From KALI (Star Nest by Pablo Roman Andrioli License: MIT ) https://www.shadertoy.com/view/XlfGRj Converted in five minutes to BGRA GL shader; Main unit; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Buttons, Spin, BGLVirtualScreen, BGRAOpenGL, BGRACMapShader, BGRABitmapTypes; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    FloatSpinEdit1: TFloatSpinEdit;    FloatSpinEdit2: TFloatSpinEdit;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    cmap_shader: TBGLCMapShader;  public   texture,gl_surface : IBGLTexture;   fnt : IBGLFont;  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin   fnt := BGLFont('Arial',30);end;  procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext); begin    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));    texture     := BGLTexture(ResourceFile('girl5.png'));    cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas); end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin    // le traitement du sampler2D comme texture     cmap_shader.Rezolution:= 1024.0;     //gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader     //BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image      // shader without texture ; canvas renderer     cmap_shader.RenderOnCanvas;      fnt.TextOut(60,560,'BGRA GL STAR NEST SHADER FROM KALI');end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  // libere et vire tout !!   texture    := nil;  gl_surface := nil;  FreeAndNil(cmap_shader);end;  procedure TForm1.FormDestroy(Sender: TObject);begin end; procedure TForm1.Timer1Timer(Sender: TObject);begin    cmap_shader.Time   := cmap_shader.Time + FloatSpinEdit1.value/1000;    cmap_shader.Factor := FloatSpinEdit2.value;    BGLVirtualScreen1.Invalidate;end; end.  Star nest shader; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { Hue X/Y Shift OpenGL shader }unit BGRACMapShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Hue X/Y Shift Shader computing shader  }  TBGLCMapShader = class(TBGLShader3D)   private   function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    FTime: TUniformVariableSingle;    FTimer : Single;     FFact: TUniformVariableSingle;    FFactV : Single;     FRez: TUniformVariableSingle;    FRezV : Single;     FImageIndex: TUniformVariableInteger;    FImage_idx : Integer;     FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;     procedure RenderOnCanvas;    // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Factor: Single read FFactV write FFactV;     property Rezolution:  Single read FRezV write FRezV;     property ImageIndex: integer read FImage_idx write FImage_idx;    property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;    end; implementation function TBGLCMapShader.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLCMapShader } constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas); begin// vertex + fragmentinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +' gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +'  gl_FrontColor = gl_Color;'#10 +' texCoord = gl_Vertex.xy / canvasSize;'#10 +' // texCoord = vec2(gl_MultiTexCoord0);'#10 +'}', // Star Nest by Pablo Roman Andrioli// License: MIT '#define iterations 16        '#10+'#define formuparam 0.53      '#10+'#define volsteps 20          '#10+'#define stepsize 0.1         '#10+'#define zoom   0.800         '#10+'#define tile   0.850         '#10+'#define speed  0.010       '#10+'#define brightness 0.0015    '#10+'#define darkmatter 0.300     '#10+'#define distfading 0.730     '#10+'#define saturation 0.850     '#10+ 'out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform float fct;'#10+'uniform float rez;'#10+'uniform sampler2D image;'#10+ 'void main()'#10 +'{'#10 +'vec2 uv =  texCoord.xy   ;                                   '#10+// flip y'   uv.y = 1.-uv.y;                                           '#10+// resolution down'uv = floor(rez*uv)/rez;                                    '#10+// move texture'vec2  xy = vec2(0.0,0.40);                                 '#10+'//uv.y*=800./600.0;                                                  '#10+'       vec3 dir=vec3(uv*zoom,1.);                                                   '#10+'       float tm=time*speed+.25;                                                    '#10+ '       float a1=.5;                                                                 '#10+'       float a2=.8;                                                                 '#10+'       mat2 rot1=mat2(cos(a1),sin(a1),-sin(a1),cos(a1));                            '#10+'       mat2 rot2=mat2(cos(a2),sin(a2),-sin(a2),cos(a2));                            '#10+'       dir.xz*=rot1;                                                                '#10+'       dir.xy*=rot2;                                                                '#10+'       vec3 from=vec3(1.,.5,0.5);                                                   '#10+'       from+=vec3(tm,0,-2.);                                                      '#10+'       from.xz*=rot1;                                                               '#10+'       from.xy*=rot2;                                                               '#10+'                                                                                    '#10+'       //volumetric rendering                                                       '#10+'       float s=0.1,fade=1.;                                                         '#10+'       vec3 v=vec3(0.);                                                             '#10+'       for (int r=0; r6) fade*=1.-dm; // dark matter, don t render near                '#10+'               //v+=vec3(dm,dm*.5,0.);                                                '#10+'               v+=fade;                                                             '#10+'               v+=vec3(s,s*s,s*s*s*s)*a*brightness*fade; // coloring based on distance'#10+'               fade*=distfading; // distance fading                                 '#10+'               s+=stepsize;                                                         '#10+'       }                                                                            '#10+'       v=mix(vec3(length(v)),v,saturation); //color adjust                          '#10+'       gl_FragColor = vec4(v*.01,1.);                                               '#10+ '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  FFact := UniformSingle['fct'];   FRez := UniformSingle['rez'];   FImageIndex := UniformInteger['image'];  FCanvasSize := UniformPointF['canvasSize'];  FImage_idx:= 0;  FTimer := 0;  FFactV := 0;  FRezV  := 512.0; end; procedure TBGLCMapShader.StartUse; begin   inherited StartUse;   FTime.Update;   FFact.Update;   FRez.Update;   FImageIndex.Update;   FCanvasSize.Update;  // set values to uniforms  FRez.Value := FRezV;  FTime.Value:=FTimer;  FFact.Value:= FFactV; end; function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader; begin  //previousBuf := Canvas.ActiveFrameBuffer;  //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  //Canvas.ActiveFrameBuffer := buf;  //Canvas.Fill(BGRAPixelTransparent);  //previousShader := Canvas.Lighting.ActiveShader;  //Canvas.Lighting.ActiveShader := self;  //ATexture.Draw(0, 0);  //  //Canvas.Lighting.ActiveShader := previousShader;  //Canvas.ActiveFrameBuffer := previousBuf;  //result := buf.MakeTextureAndFree;   // canvas renderer  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;  Canvas.Fill(BGRAPixelTransparent);  RenderOnCanvas;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree; end; procedure TBGLCMapShader.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(800,600);  Canvas.FillRect(0, 0, 800,600, CSSWhite);  Canvas.Lighting.ActiveShader := previousShader;end;end. ---------------------------------------------------------------------- circular · 2024-07-19 07:35 No idea how it works but it looks smooth and realistic. ---------------------------------------------------------------------- Gigatron · 2024-07-19 14:57 Hi , A last one start conversion faster than light (13min); This time a Shader from Optimus; Sfx : Skaven / Future Crew  (Unreal II) Live Video on YT :  https://www.youtube.com/watch?v=rNZx-MIJFU4 Shader Unit exceed the limit so it's attached in zip file; Main unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Buttons, Spin, BGLVirtualScreen, BGRAOpenGL, BGRACMapShader, BGRABitmapTypes,mmsystem; type   { TForm1 }   TForm1 = class(TForm)  BGLVirtualScreen1: TBGLVirtualScreen;    FloatSpinEdit1: TFloatSpinEdit;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    cmap_shader: TBGLCMapShader;  public   texture,gl_surface : IBGLTexture;   fnt : IBGLFont;   FWavStream : TMemoryStream;  end; var  Form1: TForm1;  fx_num : integer;  g_timer : integer; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin   fnt := BGLFont('Arial',22);   fx_num  :=0;   g_timer :=0;  // audio stream  FWavStream    := TMemoryStream.Create;  FWavStream.LoadFromFile('2nd- pm.wav');  PlaySound(FWavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY); end;  procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext); begin    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));    texture     := BGLTexture(ResourceFile('girl5.png'));    cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas); end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin    // le traitement du sampler2D comme texture     cmap_shader.Rezolution:= 512.0;     cmap_shader.Factor :=  fx_num;   //gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader     //BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image      // shader without texture ; canvas renderer     cmap_shader.RenderOnCanvas;      fnt.TextOut(0,560,'BGRA GL MULTIPLE FX FROM OPTIMUS SFX : SKAVEN/FUTURE CREW');end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  // libere et vire tout !!   texture    := nil;  gl_surface := nil;  fnt        := nil;  FreeAndNil(cmap_shader);end;  procedure TForm1.FormDestroy(Sender: TObject);begin  PlaySound(nil, 0, 0);  FWavStream.Free;end; procedure TForm1.Timer1Timer(Sender: TObject);begin    cmap_shader.Time   := cmap_shader.Time + FloatSpinEdit1.value/1000;    inc(g_timer);    if(g_timer>500) then    begin    fx_num := fx_num +1;     g_timer := 0;    if(fx_num>=26) then fx_num :=0;    end;     BGLVirtualScreen1.Invalidate;end; end. ---------------------------------------------------------------------- circular · 2024-07-19 15:46 Oh my duckling! This is a full demo we have here. Love this song! Second Reality is one of the first top demo I've seen. ---------------------------------------------------------------------- Gigatron · 2024-07-19 15:56 Quote from: circular on July 19, 2024, 05:46:38 pmOh my duckling! This is a full demo we have here. Love this song! Second Reality is one of the first top demo I've seen. It proves that with the BGRA component you can do a nice demo like all computer and console systems from Atari-600 to PSX1 @circular you did a very good job, thank you very much; ---------------------------------------------------------------------- circular · 2024-07-23 16:09 It is heartwarming to see my library help making nice demos. It is also comforting, as OpenGL support has been kind of an experiment for me. Now that we have fixed a few things, I will publish a new version of BGRABitmap. ---------------------------------------------------------------------- Gigatron · 2024-07-23 16:38 @circular I follow BGRA closely by including the shaders you did an excellent job.  I continue to make demos when I have time The Pascal language is the simplest programming language,  maybe java and javascript too !!! ---------------------------------------------------------------------- hcoenen · 2024-07-23 17:32 I cannot believe it. after years lurking these forums.... but i finally registered just to react to this thread. Absolutely love to see that the demoscene is still alive and lazarus seems to be part of it :-) brings a bit of joy to a depressed heart. Good memories that never really went away. I hope to dive into bgra sometime to understand some of it. I did glance  over some code and noticed the sound part, these are wave files. i vaguely remember most demos in the time used mod / xm / s3m format etc. the last component i dabbled with was made by benjamin rousseaux (beroxm which was win32 only) and produced much smaller (and with less quality, but hey chip tunes... so who cares?) files does anyone know if anything like that is available for lazarus nowadays? ---------------------------------------------------------------------- TRon · 2024-07-23 17:56 Quote from: hcoenen on July 23, 2024, 07:32:03 pmdoes anyone know if anything like that is available for lazarus nowadays? afaik BeroXM is still active. There exist tralala from user nickysn and there are individual (other) mod format players available for pascal as well. ---------------------------------------------------------------------- Gigatron · 2024-07-24 16:12 Quote from: hcoenen on July 23, 2024, 07:32:03 pmI cannot believe it. after years lurking these forums.... but i finally registered just to react to this thread. Absolutely love to see that the demoscene is still alive and lazarus seems to be part of it :-) brings a bit of joy to a depressed heart. Good memories that never really went away. I hope to dive into bgra sometime to understand some of it. I did glance  over some code and noticed the sound part, these are wave files. i vaguely remember most demos in the time used mod / xm / s3m format etc. the last component i dabbled with was made by benjamin rousseaux (beroxm which was win32 only) and produced much smaller (and with less quality, but hey chip tunes... so who cares?) files does anyone know if anything like that is available for lazarus nowadays? Hi, i ve just tested Fastracker module playing with lazarus fpc. (cerror.xm) playing like a charm What you need are the Raylib.dll + raylib.pas unit from Guvacode + BGRA component . Here is the example of code and live video on YT: Better colors, better code ;  https://www.youtube.com/watch?v=6o7cJ9ApGCQ  Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Buttons, BGLVirtualScreen, BGRAOpenGL, BGRACMapShader, BGRABitmapTypes,RayLib; // raylib unit type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;     Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    cmap_shader: TBGLCMapShader;   public   texture,gl_surface,phenix : IBGLTexture;   fnt,fntw : IBGLFont;   rdtimer,xpos,ypos,alfa,rdtx : integer;   txt : String;  end; var  Form1: TForm1;  music:TMusic; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin   fnt := BGLFont('Amstrad CPC464',60);   fntw := BGLFont('Amstrad CPC464',58);   xpos:= 0;   ypos:=1000;   rdtimer :=0;   alfa :=0;   txt := ' HELLO , GIGATRON PRESENTS BGRA GL SHADER EXAMPLE WITH RAYLIB FASTTRACKER XM MODULE PLAYER SFX BY: CYBERNAUT / CHAOS THANKS TO ALL MEMBERS OF MEGA- FACTORY LLC, CIRCULAR FOR THE BEST COMPONENT BGRA , GUVACODE FOR RAYLAZ, AND LAZARUS FPC TEAM AND MEMBERS SEE YOU ....';  // Initialization audio + load module  InitAudioDevice();  music := LoadMusicStream(PChar(GetApplicationDirectory + 'mods/freemind3.xm'));    // xm module  music.looping := false;  PlayMusicStream(music);end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);begin    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));    texture     := BGLTexture(ResourceFile('girl5.png'));    phenix    := BGLTexture(ResourceFile('phex.png'));    cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);begin    // le traitement du sampler2D comme texture     cmap_shader.ImageIndex:= 0;     gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader     cmap_shader.Render(texture);     BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image de miss marvel     fnt.TextOut(800-xpos,520,txt,BGRA(80,80,80,rdtx));     BGLContext.Canvas.PutImage(60,ypos,phenix,BGRA(255,255,255,alfa));   Upda]"]>BlockedsicStream(music);       // Update music buffer with new stream data only here !! end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  // libere et vire tout !!  texture    := nil;  gl_surface := nil;  FreeAndNil(cmap_shader);end; procedure TForm1.FormDestroy(Sender: TObject);begin // De- Initialization UnloadMusicStream(music);  // Unload music stream buffers from RAM CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)end; procedure TForm1.Timer1Timer(Sender: TObject);begin    inc(rdtimer);  if (rdtimer >= 10) then    begin      rdtimer :=0;      inc(alfa);      rdtx:= 50+Random(200);      if(alfa>=255) then alfa:=255;    end;   cmap_shader.Time   := cmap_shader.Time+ 0.006;   inc(xpos,2);   if(xpos>16800) then xpos :=0;   if(ypos>0) then dec(ypos) else ypos:=0;    BGLVirtualScreen1.Invalidate;end; end.   Conclusion you can play xm module with BGRA component + glsl shader etc ! Not tested .s3m or .mod format ; ** Edit : original mod format is working mean protracker module, not saved with openmpt tracker;    Screamtracker module .s3m not working ? don't know why yet ?? Feel free to contact me if you want simple example  ; Regards Gigatron ---------------------------------------------------------------------- lainz · 2024-07-26 02:20 Hi can you please try making this video effect? https://music.youtube.com/watch?v=kDrjY2F5JUI&si=xuQCHLpFc3OFBKg8 ---------------------------------------------------------------------- Gigatron · 2024-07-26 12:01 Hi It reminds me of an old shader based on the kaleidoscope, I'll look in my shader archives... so be patient Quick made demo for testing the result based on an old shader ;  Video example here : https://www.youtube.com/watch?v=sEAVEZdV7X0 **** Hope you like it ; There is a problem between the original shader ; My mistake, the texture must be power of 2 size , sorry !!! Main unit: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Buttons, Spin, BGLVirtualScreen, BGRAOpenGL, BGRAKaleidoscopeShader,  BGRATextFX, BGRAGradients, BGRAFontGL, BGRABitmapTypes, RayLib; // raylib unit type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    FloatSpinEdit1: TFloatSpinEdit;    Timer1: TTimer;    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;    BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);  procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private     k_shader: TBGLKaleidoscopeShader;   public   texture,gl_surface : IBGLTexture;  end; var  Form1: TForm1;  music:TMusic;  master_vol : single; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin    // Initialization audio + load module  InitAudioDevice();  music := LoadMusicStream(PChar(GetApplicationDirectory + 'mental_delivrance.xm'));    // xm module  master_vol := 0;  music.looping := true;  PlayMusicStream(music);end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);begin     // le traitement du sampler2D comme texture     k_shader.ImageIndex:= 0;     gl_surface :=k_shader.Render(texture); // container de l'image affichee par le shader     //k_shader.Render(texture);     BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image de miss marvel      SetMasterVolume(master_vol);     if( master_vol<1.0) then master_vol := master_vol + 0.002;     Upda]"]>BlockedsicStream(music);       // Update music buffer with new stream data only here !!end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);begin    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));    texture     := BGLTexture(ResourceFile('galaxy.jpg'));    k_shader := TBGLKaleidoscopeShader.Create(BGLContext.Canvas);end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin   texture    := nil;   gl_surface := nil;   FreeAndNil(k_shader);end; procedure TForm1.FormDestroy(Sender: TObject);begin   // De-Initialization UnloadMusicStream(music);  // Unload music stream buffers from RAM CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)end; procedure TForm1.Timer1Timer(Sender: TObject);begin     k_shader.Time   := k_shader.Time+ 0.04;     k_shader.Factor  := FloatSpinEdit1.Value;     BGLVirtualScreen1.Invalidate;end; end.  Source kaleidoscope shader unit: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception { Hue X/Y Shift OpenGL shader }unit BGRAKaleidoscopeShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type  { Hue X/Y Shift Shader computing shader  }  TBGLKaleidoscopeShader = class(TBGLShader3D)   private   function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    FTime: TUniformVariableSingle;    FTimer : Single;     FFact: TUniformVariableSingle;    FFactV : Single;     FImageIndex: TUniformVariableInteger;    FImage_idx : Integer;     FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;     procedure RenderOnCanvas;    // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Factor: Single read FFactV write FFactV;     property ImageIndex: integer read FImage_idx write FImage_idx;    property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;   end; implementation function TBGLKaleidoscopeShader.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLKaleidoscopeShader.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLKaleidoscopeShader } constructor TBGLKaleidoscopeShader.Create(ACanvas: TBGLCustomCanvas); begin// vertex + fragmentinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +'  gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +'  texCoord = vec2(gl_MultiTexCoord0);'#10 +'}', 'out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform float fct;'#10+'uniform sampler2D image;'#10+ 'vec2 kaleidoscope(vec2 uv)                             '#10+'{                                                      '#10+'       float th = atan(uv.y, uv.x);                        '#10+'       float r = pow(length(uv), .9);                      '#10+'       float f = 3.14159 / 6.5;                            '#10+'       th = abs(mod(th + f/4.0, f) - f/2.0) / (1.0 + r);   '#10+'       return vec2(cos(th), sin(th)) * r * .1;               '#10+'}                                                        '#10+'                                                       '#10+'vec2 transform(vec2 at)                                  '#10+'{                                                      '#10+'       vec2 v = vec2(0.0,0.0);                               '#10+'       float th = .02 * time;                               '#10+'       v.x = at.x * cos(th) - at.y * sin(th) - .2 * sin(th); '#10+'       v.y = at.x * sin(th) + at.y * cos(th) + .2 * cos(th); '#10+'       return v;                                           '#10+'}                                                      '#10+  'void main()'#10 +'{'#10 +'vec2 uv =  texCoord.xy  ;                                   '#10+// flip y'   uv.y = 1.-uv.y;                                           '#10+// resolution down'//   uv = floor(128.0*uv)/128.0;'#10+// move texture xy position in uv' vec2  xy = vec2(0.40,0.70);'#10+ '  gl_FragColor = texture2D(image, transform(kaleidoscope(uv-xy))*fct); '#10+' // gl_FragColor = texture2D(image, uv-xy); '#10+    // debug image // fin '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  FFact := UniformSingle['fct']; ;   FImageIndex := UniformInteger['image'];  FCanvasSize := UniformPointF['canvasSize'];  FImage_idx:= 0;  FTimer := 0;  FFactV := 0.0;end; procedure TBGLKaleidoscopeShader.StartUse;begin  inherited StartUse;  FTime.Update;  FTime.Value:=FTimer;  FImageIndex.Update;  // set values to uniforms   FFact.Update;  FFact.Value:= FFactV; // FCanvasSize.Update; end; function TBGLKaleidoscopeShader.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;  Canvas.Fill(BGRAPixelTransparent);  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;   // canvas renderer  //previousBuf := Canvas.ActiveFrameBuffer;  //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  //Canvas.ActiveFrameBuffer := buf;  //Canvas.Fill(BGRAPixelTransparent);  //RenderOnCanvas;  //Canvas.ActiveFrameBuffer := previousBuf;  //result := buf.MakeTextureAndFree; end; procedure TBGLKaleidoscopeShader.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(800,600);  Canvas.FillRect(0, 0, 800,600, CSSWhite);  Canvas.Lighting.ActiveShader := previousShader;end;end. ---------------------------------------------------------------------- lainz · 2024-07-26 22:25 Awesome!! ---------------------------------------------------------------------- Gigatron · 2024-07-30 11:34 Hi, I'm currently watching the Olympics games so not much time however a conversion of a nice shader with the bgra component was inevitable; I send the video to YT for the result; https://www.youtube.com/watch?v=F4nHntYCImc Regards Gtr ---------------------------------------------------------------------- Gigatron · 2024-08-06 15:29 Hi , Let's make another shader with BGRA component to manipulate texture image, it can doable with BGRA transform function but made with shader. The result on YT video : https://www.youtube.com/watch?v=Xmb5e1ySEUU ** The next shader will be a Textured Cube-Map !! Main unit: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Buttons, BGLVirtualScreen, BGRAOpenGL, BGRACMapShader,BGRATextFX,  BGRAGradients,BGRAFontGL, BGRABitmapTypes,RayLib ; // raylib unit type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;    ElapsedMs: integer);    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);    private    cmap_shader: TBGLCMapShader;    GLBigFont: IBGLFont;    bigFont: TBGLRenderedFont;  public   texture,gl_surface,phenix : IBGLTexture;   fnt,fntw : IBGLFont;   rdtimer,xpos,ypos,rdtx,txpos: integer;   txt : String;   zval : single;   rez  : single;   rotx,roty,rotz,skew_x,skew_y,rr,gg,bb,intensity : single;   alfa : byte;   fade : boolean;    demo_timer : integer;    procedure RotationXYZ;   procedure Fadein;   procedure Fadeout;    end; var  Form1: TForm1;  music:TMusic;  implementation {$R *.lfm} { TForm1 }  procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);begin         // le traitement du sampler2D comme texture     cmap_shader.ImageIndex:= 0;     gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader     BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); //   surface qui contient le shader     GLBigFont.TextOut(800-xpos,520,txt,BGRA(250,250,250,255));     BGLContext.Canvas.PutImage(txpos,ypos,phenix,BGRA(255,255,255,alfa) );      bigFont.Color := BGRA(0,220,255,255); end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext); var bigRender: TBGRATextEffectFontRenderer;  shader : TPhongShading; begin    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));    texture     := BGLTexture(ResourceFile('girl5.png'));    phenix    := BGLTexture(ResourceFile('gtrn.png'));    cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);    // font    shader := TPhongShading.Create;    shader.LightPosition := Point(100, 100);    shader.LightPositionZ:=5;    shader.AmbientFactor:=0.2;    shader.SpecularFactor:=1.0;    shader.LightSourceDistanceTerm := 200;    shader.LightColor:=BGRA(255,255,255,255);    bigRender := TBGRATextEffectFontRenderer.Create(shader, true);    bigFont  := TBGLRenderedFont.Create(bigRender, true);    bigFont.Name := 'BlackWhiteBlock';    bigFont.EmHeight := 72;     GLBigFont := bigFont; end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin          // libere et vire tout !!  texture    := nil;  gl_surface := nil;  GLBigFont := nil;  FreeAndNil(cmap_shader);end; procedure TForm1.FormCreate(Sender: TObject);begin   xpos:= -1600;   ypos:=1000;   rdtimer :=0;   alfa :=1;   fade :=false;   txt := ' HELLO    GIGATRON   PRESENTS   BGRA   GL   SHADER    EXAMPLE    THIS    TIME   WE   CAN   CHANGE   UNIFORMS ON   THE   FLY   SFX : BY  KARSTEN  KOCH  ARYX  S3M  CONVERTED  TO  FASTTRACKER  MODULE  THANX  TO  CIRCULAR  FOR  THE  BEST  COMPONENT  BGRA  .  GUVACODE  FOR  RAYLAZ  USED  TO  PLAY  XM   OR   MOD    FORMAT  . GREETINGS  TO  THE  LAZARUS  FPC  TEAM  AND  THE  MEMBERS  OF   QUANTUM   TECHNOLOGY  !!!!  SEE YOU  ....';    zval :=0;   rez  :=16.0;    rotz :=0.0;   rotx :=0.0;   roty :=0.0;   rr   := 1.0;   gg   := 1.0;   bb   := 1.0;   intensity :=1.0;  // Initialization audio + load module  InitAudioDevice();  music := LoadMusicStream(PChar(GetApplicationDirectory + 'aryx.xm'));    // xm module  music.looping := false;  SetMusicPitch(music,1.05);  PlayMusicStream(music);end; procedure TForm1.FormDestroy(Sender: TObject);begin end; procedure TForm1.Timer1Timer(Sender: TObject);begin   inc(demo_timer);   inc(rdtimer);    inc(xpos,4);   if(xpos>24000) then   begin   xpos :=24000;   end;    if(ypos>0) then dec(ypos,30) else ypos:=0;   if(demo_timer>200)  then  fade := true;   if(demo_timer>1200)  then  fade := false;   if(demo_timer>1400)  then  RotationXYZ;    if(demo_timer>4000)  then  fade := true;    if fade then Fadein;   if not fade then Fadeout;     if(rdtimer>100+Random(200)) then   begin      rr := Random(255)/255;      gg := Random(255)/255;      bb := Random(255)/255;      rdtimer :=0;     intensity := 1.0 +Random(255)/255;    end;     skew_x :=   0.08*sin(Round(demo_timer)*0.05);    skew_y :=   0.08*sin(Round(demo_timer)*0.02);    BGLVirtualScreen1.Invalidate;end; procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;  BGLContext: TBGLContext; ElapsedMs: integer);begin    // sprite uniforms   cmap_shader.Time   := cmap_shader.Time + 0.004;   cmap_shader.Zoom := zval;    if(zval<9.0) then zval:=zval + 0.02;    if(rez<512.0) then rez:=rez + 1.0;    cmap_shader.Transx := -0.40;   cmap_shader.Transy := -0.80;   cmap_shader.Factor:= rez;    cmap_shader.Skewx:= skew_x;   cmap_shader.Skewy:= skew_y;    cmap_shader.Rotx := rotx;   cmap_shader.Roty := roty;   cmap_shader.Rotz := rotz-0.5;    cmap_shader.Red       := rr;   cmap_shader.Green     := gg;   cmap_shader.Blue      := bb;    cmap_shader.Intensity := intensity;    Upda]"]>BlockedsicStream(music);       // Update music buffer with new stream data only here !!  end; procedure TForm1.RotationXYZ();begin  if(rotx>-4.0) then rotx:= rotx -0.01;  if(rotx<=-4.0) then  begin  if(roty>-4.0) then  roty := roty -0.01;   if(roty<=-4.0) then  begin     if(rotz>-4.0) then  rotz := rotz -0.005;       if(rotz<=-4.0) then     begin         rotx:= rotx -0.005;         roty := roty -0.01;         rotz := rotz +0.005;      end;  end;   end;  end;   procedure TForm1.Fadein();begin   if alfa<>255 then inc(alfa);end; procedure TForm1.Fadeout();begin  if alfa<>1 then dec(alfa);end; end. ---------------------------------------------------------------------- Gigatron · 2024-08-06 15:30 Here is the shader Unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception unit BGRACMapShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type   TBGLCMapShader = class(TBGLShader3D)   private   function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    FTime: TUniformVariableSingle;    FTimer : Single;    FFact: TUniformVariableSingle;    FFactV : Single;    // sprite utility uniforms :) 50000 uniforms    FDebug  : TUniformVariableSingle;    FDebugV : Single;    FRotx  : TUniformVariableSingle;    FRotxV : Single;    FRoty  : TUniformVariableSingle;    FRotyV : Single;    FRotz  : TUniformVariableSingle;    FRotzV : Single;   // -- translate xy + roll xy    FTrx  : TUniformVariableSingle;    FTrxV : Single;    FTry  : TUniformVariableSingle;    FtryV : Single;    FRlx  : TUniformVariableSingle;    FRlxV : Single;    FRly  : TUniformVariableSingle;    FRlyV : Single;   //  skew    FSkewx  : TUniformVariableSingle;    FSkewxV : Single;    FSkewy  : TUniformVariableSingle;    FSkewyV : Single;    Fzoom   : TUniformVariableSingle;    FzoomV  : Single;    // colors    FRed     : TUniformVariableSingle;    FRedV    : Single;    FGreen   : TUniformVariableSingle;    FGreenV  : Single;    FBlue    : TUniformVariableSingle;    FBlueV   : Single;    // intensity    Fintensity  : TUniformVariableSingle;    FintensityV : Single;      FImageIndex: TUniformVariableInteger;    FImage_idx : Integer;     FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;     procedure RenderOnCanvas;    // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Factor: Single read FFactV write FFactV;    // uniforms for sprite utility    property Debug: Single read FDebugV write FDebugV;    property Rotx:  Single read FRotxV  write FRotxV;    property Roty:  Single read FRotyV  write FRotyV;    property Rotz:  Single read FRotzV  write FRotzV;     property Transx: Single read FTrxV  write FTrxV;    property Transy: Single read FTryV  write FTryV;    property Rolx:   Single read FRlxV  write FRlxV;    property Roly:   Single read FRlyV  write FRlyV;     property Skewx:  Single read FSkewxV  write FSkewxV;    property Skewy:  Single read FSkewyV  write FSkewyV;     property Zoom:  Single read FzoomV  write FzoomV;     property Red  :  Single read FRedV  write FRedV;    property Green:  Single read FGreenV  write FGreenV;    property Blue :  Single read FBlueV  write FBlueV;     property Intensity :  Single read FintensityV  write FintensityV;      property ImageIndex: integer read FImage_idx write FImage_idx;    property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;   end; implementation function TBGLCMapShader.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLCMapShader } constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas); begin// vertexinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +'  gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +'}', // fragment shader'out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform float fct;'#10+'uniform sampler2D image;'#10+ 'uniform float debug;'#10+'uniform float rot_x;'#10+'uniform float rot_y;'#10+'uniform float rot_z;'#10+'uniform float trx,try,rlx,rly;      '#10+'uniform float skewx,skewy;            '#10+'uniform float zoom;                   '#10+'uniform float intensity,bg_red,bg_green,bg_blue;'#10+'uniform float cmode,slmode,rmode;               '#10+  '#define Pi 3.14159265359                                                 '#10+'                                                                         '#10+'vec3 planeInt(vec3 normal, vec3 rayorg, vec3 raydir) {                     '#10+'return rayorg + (raydir * (dot(-rayorg, normal) / dot(normal, raydir)));   '#10+'}                                                                        '#10+'                                                                         '#10+'mat4 setTranslation( float x, float y, float z )                           '#10+'{                                                                        '#10+'    return mat4( 1.0, 0.0, 0.0, 0.0,                                     '#10+'                                0.0, 1.0, 0.0, 0.0,                      '#10+'                                rlx, rly, 1.0, 0.0,                      '#10+'                                x,     y, z, 1.0 );                      '#10+'}                                                                        '#10+'                                                                         '#10+' mat3 xrot(float t)                                                        '#10+'{                                                                        '#10+'    return mat3(1.0, 0.0, 0.0,                                           '#10+'                0.0, cos(t), -sin(t),                                    '#10+'                0.0, sin(t), cos(t));                                      '#10+'}                                                                        '#10+'                                                                         '#10+'mat3 yrot(float t)                                                       '#10+'{                                                                        '#10+'    return mat3(cos(t), 0.0, -sin(t),                                    '#10+'                0.0, 1.0, 0.0,                                           '#10+'                sin(t), 0.0, cos(t));                                      '#10+'}                                                                        '#10+'                                                                       '#10+'mat3 zrot(float t)                                                       '#10+'{                                                                        '#10+'    return mat3(cos(t), -sin(t), 0.0,                                    '#10+'                sin(t), cos(t), 0.0,                                       '#10+'                0.0, 0.0, 1.0);                                            '#10+'}                                                                        '#10+'                                                                         '#10+'                                                                         '#10+'vec3 rotateEuler(vec3 position, vec3 a) {                                '#10+'    mat4 rx = mat4(1., 0., 0., 0.,                                       '#10+'                  0., cos(a.x), -sin(a.x), 0.,                             '#10+'                  0., sin(a.x), cos(a.x), 0.,                              '#10+'                0., 0., 0., 1.);                                         '#10+'  mat4 ry = mat4(cos(a.y), 0., sin(a.y), 0.,                           '#10+'                  0.,        1., 0.,     0.,                             '#10+'                  -sin(a.y), 0., cos(a.y),0.,                            '#10+'                  0.,           0., 0.,        1.);                      '#10+'    mat4 rz = mat4(cos(a.z), -sin(a.z), 0., 0.,                            '#10+'                  sin(a.z),  cos(a.z),  0., 0.,                            '#10+'                0.,           0.,            1., 0.,                     '#10+'                  0.,           0.,            0., 1.);                  '#10+'    mat4 r = rx * ry * rz;                                               '#10+'    return (vec4(position, 1.) * r).xyz;                                 '#10+'}                                                                        '#10+ 'void main()'#10 +'{'#10 +'//vec2 uv =  texCoord.xy   ;                                   '#10+// flip y//' uv.y = 1.-uv.y;                                         '#10+// resolution down//'uv = floor(256.0*uv)/256.0;'#10+// texture xy_position'vec2  xy_pos = vec2(0.09,0.25);'#10+ 'vec3 dir = normalize(vec3(texCoord*2.-1.0 , 5.));'#10+'vec3 eye = vec3(trx,try,zoom);                             '#10+'float scl = mod(gl_FragCoord.y ,3.0)*mod(gl_FragCoord.y ,3.0);'#10+ '    float v = sin(time);                                        '#10+'    float x = v * Pi;                                           '#10+'    float y = v * Pi;                                           '#10+'    vec3 r = vec3(rot_y*Pi, rot_x*Pi,rot_z*Pi);                 '#10+ '                                                              '#10+'    vec3 pNormal = rotateEuler (vec3(0.0,0.0,1.0), r);          '#10+'    vec3 pTangent = rotateEuler(vec3(0.0,1.0,0.0), r);          '#10+'                                                              '#10+'    vec3 pBitangent = cross(pTangent, pNormal);                 '#10+'    vec3 i = planeInt(pNormal, eye, dir);                       '#10+'                                                              '#10+'                                                              '#10+'    float sideT =   dot(i, pTangent) -  (Pi / 2.);                 '#10+'    float sideBiT = dot(i, pBitangent) - (Pi / 2.);             '#10+'   vec2  uv = (- 0.33) * (vec2(sideT, sideBiT));             '#10+'                                                               '#10+'             uv   =  floor(uv*fct)/fct;                    '#10+'         uv.x =1.-uv.x;                                       '#10+'             //***********************                        '#10+'             float xx = uv.x;                                 '#10+'             float yy = uv.y;                                 '#10+'             float m = (xx-0.5)*(xx+0.5)+sin(time);        '#10+'                                                              '#10+'               //uv.y = uv.y + m*cmode;                         '#10+'               //uv.x = uv.x + m*cmode;                         '#10+'                                                              '#10+'               uv.y += uv.x*skewy ; // sky                      '#10+'               uv.x += uv.y*skewx;                              '#10+'               //****************************                   '#10+'       vec3 tx = texture2D(image, uv - xy_pos ).xyz;            '#10+'if (uv.x < 1. && uv.y < 1. && uv.x > 0. && uv.y > 0.) {                      '#10+'                                                                         '#10+'  gl_FragColor = vec4(tx.r*bg_red,tx.g*bg_green,tx.b*bg_blue,1.0)* intensity; '#10+'} else {                                                                 '#10+'                                                                        '#10+'               if(debug==1.0) gl_FragColor = vec4(0.1, 0.6, .9, 1.0);     '#10+'        else                                                            '#10+'               gl_FragColor = vec4(0.0, 0.0, .0, 0.0);                    '#10+'                                                                        '#10+'}                                                                       '#10+   '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  FFact := UniformSingle['fct'];       // reserved   FDebug := UniformSingle['debug'];  FRotx  := UniformSingle['rot_x'];  FRoty  := UniformSingle['rot_y'];  FRotz  := UniformSingle['rot_z'];   FTrx   := UniformSingle['trx'];  FTry   := UniformSingle['try'];  FRlx   := UniformSingle['rlx'];  FRly   := UniformSingle['rly'];   FSkewx := UniformSingle['skewx'];  FSkewy := UniformSingle['skewy'];  Fzoom  := UniformSingle['zoom'];   FRed   := UniformSingle['bg_red'];  FGreen := UniformSingle['bg_green'];  FBlue  := UniformSingle['bg_blue'];   Fintensity := UniformSingle['intensity'];    FImageIndex := UniformInteger['image'];  FCanvasSize := UniformPointF['canvasSize'];  FImage_idx:= 0;  FTimer := 0;  FFactV := 0.0;  FzoomV:= 2.0;end; procedure TBGLCMapShader.StartUse;begin  inherited StartUse;  FTime.Update;  FTime.Value:=FTimer;  FImageIndex.Update;  // set values to uniforms   FFact.Update;  FFact.Value:= FFactV;  FCanvasSize.Update;  // sprite  Fzoom.Update;  Fzoom.Value:=FzoomV;   FSkewx.Update;  FSkewx.Value:= FSkewxV;  FSkewy.Update;  FSkewy.Value:= FSkewyV;   FRlx.Update;  FRly.Update;  Frlx.Value:= FRlxV;  Frly.Value:= FRlyV;   FTrx.Update;  FTry.Update;  FTrx.Value:= FTrxV;  FTry.Value:= FTryV;   FRotx.Update;  FRoty.Update;  FRotz.Update;  FRotx.Value:= FRotxV;  FRoty.Value:= FRotyV;  FRotz.Value:= FRotzV;   FRed.Update;  FGreen.Update;  FBlue.Update;  FRed.Value   := FRedV;  FGreen.Value := FGreenV;  FBlue.Value  := FBlueV;   FIntensity.Update;  Fintensity.Value:= FintensityV; end; function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin  previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf; // Canvas.Fill(BGRAPixelTransparent);   Canvas.FillRect(0, 0, 800,600, CSSBlack);  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  ATexture.Draw(0, 0); // Atexture.StretchDraw(0,0,800+200,600,BGRA(255,255,255,255));  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;   // canvas renderer  //previousBuf := Canvas.ActiveFrameBuffer;  //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  //Canvas.ActiveFrameBuffer := buf;  //Canvas.Fill(BGRAPixelTransparent);  //RenderOnCanvas;  //Canvas.ActiveFrameBuffer := previousBuf;  //result := buf.MakeTextureAndFree; end; procedure TBGLCMapShader.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(800,600);  Canvas.FillRect(0, 0, 800,600, CSSBlack);  Canvas.Lighting.ActiveShader := previousShader;end;end. ---------------------------------------------------------------------- Gigatron · 2024-08-07 19:55 Hi, made a quick demo with the new shader; Will include cleaned code here after removing some stuff like starfield etc. Result on YT : https://www.youtube.com/watch?v=8dEqSzHQrtY Projet is now included in zip format; The texture must be power of two ,2,4,8,16,32,64,128,256,512,1024,2048,4096,8196 ... this mean the size must be power of 2; 256x256 is an example of texture size : width = 256 height = 256 Regards ---------------------------------------------------------------------- Gigatron · 2024-08-13 18:27 Hi, Today i presents another glsl shader demo called 8 bit colors. This shader reduce color  texture to , TWOBGS, BW, NES, EGA, CPC-464, CGA, GAMEBOY, TELETEXT, SMS, C-64, Z-80, MSX. The original code is from shadertoy and include some console palettes by me, matrix dither is removed pixelate mode used. So look the code and result on YT : https://www.youtube.com/watch?v=etpXRk92Mfs Main unit; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls, BGRABitmap, BGRABitmapTypes, BGRACMapShader, BGLVirtualScreen,  BGRAOpenGL, BGRAText,BGRATextFX,  BGRAGradients,BGRAFontGL, RayLib ; // raylib unit; type   { TForm1 }   TForm1 = class(TForm)      BGLVirtualScreen1: TBGLVirtualScreen;      Button1: TButton;      OpenDialog1: TOpenDialog;    Timer1: TTimer;    procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;    ElapsedMs: integer);    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure Button1Click(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure FormPaint(Sender: TObject);    procedure Timer1Timer(Sender: TObject);     procedure LoadPicture();    private    cmap_shader: TBGLCMapShader;    GLBigFont: IBGLFont;    bigFont: TBGLRenderedFont;    public    texture0,gl_surface,phenix: IBGLTexture;    barreHaut,barreBas :IBGLTexture;   end; var  Form1: TForm1;  txt : String= 'GIGATRON THE LEADER PRESENTS ANOTHER BGRA GL SHADER DEMO EXAMPLE  - 8 BIT COLORS - BASE SOURCE FROM SHADERTOY  TWOBGS, BW, NES, EGA, CPC-464, CGA, GAMEBOY, TELETEXT, SMS, C-64, Z-80, MSX  .. SFX : TURTLE    GFX : GUWEIZ   GREETING LIST IN ORDER :  CIRCULAR  GUVACODE  TRONIC-DESIGN  MAGIC-FACTORY  LAZARUS FPC TEAM AND THE MEMBERS OF QUANTUM TECHNOLOGY !!!!SEE YOU ON NEXT DEMO BYE!!! ....' ;  xpos : integer;  x_sin : single;  demo_timer,effect_timer,cmode : integer;  alfa : byte;   music:TMusic; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  demo_timer :=0 ;  xpos:= -160;  // Initialization audio + load module  InitAudioDevice();  music := LoadMusicStream(PChar(GetApplicationDirectory + 'sublimity.mod'));    // xm module  music.looping := true; // SetMusicPitch(music,1.05);  PlayMusicStream(music);end; procedure TForm1.FormPaint(Sender: TObject);begin end; procedure TForm1.Timer1Timer(Sender: TObject);begin  BGLVirtualScreen1.Invalidate; end; procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;  BGLContext: TBGLContext; ElapsedMs: integer);  var bigRender: TBGRATextEffectFontRenderer;  shader : TPhongShading;begin    // cmap_shader.Time := cmap_shader.Time +0.004;     cmap_shader.Cmode:=cmode;     if (cmode>0) then cmap_shader.Intensity := 1.50     else     cmap_shader.Intensity :=1.0;    inc(xpos,2);   if(xpos>24000) then   begin   xpos :=24000;   end;   inc(effect_timer);   inc(demo_timer);    if(demo_timer>100) then   begin     if alfa<>255 then inc(alfa);   end;  if(demo_timer>400) then  x_sin := x_sin +0.02;    if(effect_timer>500) then   begin   cmode:=cmode +1;   if(cmode>=13) then cmode :=0;   effect_timer :=0;   end;  end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);   var bigRender: TBGRATextEffectFontRenderer;    shader : TPhongShading; begin   texture0     := BGLTexture(ResourceFile('girl512-4.png'));  // texture must power of TWO size !!   gl_surface := BGLTexture(ResourceFile('gl_surface.png'));   phenix    := BGLTexture(ResourceFile('gtr.png'));   cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);   // les barres    barreHaut     := BGLTexture(ResourceFile('barre_haut.png'));    barreBas     := BGLTexture(ResourceFile('barre_bas.png'));    // font    shader := TPhongShading.Create;    shader.LightPosition := Point(10, 100);    shader.LightPositionZ:=20;    shader.AmbientFactor:=0.2;    shader.SpecularFactor:=1.0;    shader.LightSourceDistanceTerm := 200;    shader.LightColor:=BGRA(255,255,255,255);    bigRender := TBGRATextEffectFontRenderer.Create(shader, true);    bigFont  := TBGLRenderedFont.Create(bigRender, true);    bigFont.Name := 'Dynamic Recompilation';    bigFont.EmHeight := 24;    //bigFont.Style:=[fsBold];    GLBigFont := bigFont;  end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);begin      // le traitement du sampler2D comme texture   cmap_shader.Image0 := 0;     //cmap_shader.Intensity:= 1.0;     gl_surface := cmap_shader.Render(texture0);   // container de l'image0 affichee par le shader     BGLContext.Canvas.PutImage(0,0,texture0,BGRA(255,255,255,255));     BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);      BGLContext.Canvas.PutImage(0,0,barreHaut,BGRA(255,255,255,255));    BGLContext.Canvas.PutImage(130+160.0*sin(x_sin)*0.8,0,phenix,BGRA(255, 255,255,alfa));     BGLContext.Canvas.PutImage(0,558,barreBas,BGRA(255,255,255,255));     GLBigFont.TextOut(800-xpos,562,txt,BGRA(250,250,250,255));     bigFont.Color := BGRA(25,25,25,255);     Upda]"]>BlockedsicStream(music);       // Update music buffer with new stream data only here !!end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin      // libere les textures et le shader !!  texture0    := nil;  gl_surface := nil;   GLBigFont := nil;  barreHaut:= nil;  barreBas := nil;  FreeAndNil(cmap_shader);    FreeAndNil(cmap_shader);  end; procedure TForm1.Button1Click(Sender: TObject);begin      LoadPicture();end; procedure TForm1.LoadPicture; begin        if (OpenDialog1.Execute) then        begin        texture0 := BGLTexture(ResourceFile(OpenDialog1.FileName));         end;end;  end. ---------------------------------------------------------------------- Gigatron · 2024-08-13 18:30 Shader unit of the demo above ,  you can change the name of the unit yourself ! Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception unit BGRACMapShader; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type   TBGLCMapShader = class(TBGLShader3D)   private   function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    // time    FTime: TUniformVariableSingle;    FTimer : Single;    // intensity    Fintensity  : TUniformVariableSingle;    FintensityV : Single;    // Color mode    FMode  : TUniformVariableSingle;    FModeV : Single;   FImage0: TUniformVariableInteger;    FImage0V : Integer;     FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;    procedure RenderOnCanvas;    // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Intensity :  Single read FintensityV  write FintensityV;    property Cmode :  Single read FModeV  write FModeV ;      property Image0: integer read FImage0V write FImage0V;     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;    end; implementation function TBGLCMapShader.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLCMapShader } constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas); begin// vertexinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +' // gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +'}', // fragment shader'//out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform sampler2D tex;'#10+'uniform float intensity;                      '#10+'uniform float c_mode;                           '#10+ 'vec3 find_closest (in vec3 ref) {                                                     '#10+'vec3 old = vec3 (100.0*255.0);                                                        '#10+'#define TRY_COLOR(new) old = mix (new, old, step (length (old-ref), length (new-ref))); '#10+'                                                                                      '#10+'                                                                                      '#10+// TWOBGS'    if(c_mode==1.0){                                                                  '#10+'    TRY_COLOR (vec3 (000.0, 000.0, 000.0));                                             '#10+'    TRY_COLOR (vec3 (103.0, 103.0, 103.0));                                           '#10+'    TRY_COLOR (vec3 (184.0, 184.0, 184.0));                                           '#10+'    TRY_COLOR (vec3 (255.0, 255.0, 255.0));                                             '#10+'    }                                                                                 '#10+// BW'    if(c_mode==2.0){                                                                  '#10+'    TRY_COLOR (vec3 (000.0, 000.0, 000.0));                                             '#10+'    TRY_COLOR (vec3 (255.0, 255.0, 255.0));                                           '#10+'    }                                                                                 '#10+ 'if(c_mode==3.0){                              '#10+'    TRY_COLOR (vec3 (000.0, 000.0, 000.0));   '#10+'    TRY_COLOR (vec3 (255.0, 000.0, 000.0));   '#10+'  TRY_COLOR (vec3 (000.0, 255.0, 000.0));   '#10+'    TRY_COLOR (vec3 (000.0, 000.0, 255.0));   '#10+'    TRY_COLOR (vec3 (000.0, 255.0, 255.0));   '#10+'    TRY_COLOR (vec3 (255.0, 000.0, 255.0));   '#10+'  TRY_COLOR (vec3 (255.0, 255.0, 000.0));   '#10+'    TRY_COLOR (vec3 (255.0, 255.0, 255.0));   '#10+'    }                                         '#10+'if(c_mode==4.0){                                '#10+'     TRY_COLOR (vec3 (000.0, 000.0, 000.0));    '#10+'       TRY_COLOR (vec3 (080.0, 048.0, 000.0));    '#10+'       TRY_COLOR (vec3 (000.0, 104.0, 000.0));    '#10+'       TRY_COLOR (vec3 (000.0, 064.0, 088.0));    '#10+'       TRY_COLOR (vec3 (000.0, 120.0, 000.0));    '#10+'       TRY_COLOR (vec3 (136.0, 020.0, 000.0));    '#10+'       TRY_COLOR (vec3 (000.0, 168.0, 000.0));    '#10+'       TRY_COLOR (vec3 (168.0, 016.0, 000.0));    '#10+'       TRY_COLOR (vec3 (168.0, 000.0, 032.0));    '#10+'       TRY_COLOR (vec3 (000.0, 168.0, 068.0));    '#10+'       TRY_COLOR (vec3 (000.0, 184.0, 000.0));    '#10+'       TRY_COLOR (vec3 (000.0, 000.0, 188.0));    '#10+'       TRY_COLOR (vec3 (000.0, 136.0, 136.0));    '#10+'       TRY_COLOR (vec3 (148.0, 000.0, 132.0));    '#10+'       TRY_COLOR (vec3 (068.0, 040.0, 188.0));    '#10+'       TRY_COLOR (vec3 (120.0, 120.0, 120.0));    '#10+'       TRY_COLOR (vec3 (172.0, 124.0, 000.0));    '#10+'       TRY_COLOR (vec3 (124.0, 124.0, 124.0));    '#10+'       TRY_COLOR (vec3 (228.0, 000.0, 088.0));    '#10+'       TRY_COLOR (vec3 (228.0, 092.0, 016.0));    '#10+'       TRY_COLOR (vec3 (088.0, 216.0, 084.0));    '#10+'       TRY_COLOR (vec3 (000.0, 000.0, 252.0));    '#10+'       TRY_COLOR (vec3 (248.0, 056.0, 000.0));    '#10+'       TRY_COLOR (vec3 (000.0, 088.0, 248.0));    '#10+'       TRY_COLOR (vec3 (000.0, 120.0, 248.0));    '#10+'       TRY_COLOR (vec3 (104.0, 068.0, 252.0));    '#10+'       TRY_COLOR (vec3 (248.0, 120.0, 088.0));    '#10+'       TRY_COLOR (vec3 (216.0, 000.0, 204.0));    '#10+'       TRY_COLOR (vec3 (088.0, 248.0, 152.0));    '#10+'       TRY_COLOR (vec3 (248.0, 088.0, 152.0));    '#10+'       TRY_COLOR (vec3 (104.0, 136.0, 252.0));    '#10+'       TRY_COLOR (vec3 (252.0, 160.0, 068.0));    '#10+'       TRY_COLOR (vec3 (248.0, 184.0, 000.0));    '#10+'       TRY_COLOR (vec3 (184.0, 248.0, 024.0));    '#10+'       TRY_COLOR (vec3 (152.0, 120.0, 248.0));    '#10+'       TRY_COLOR (vec3 (000.0, 232.0, 216.0));    '#10+'       TRY_COLOR (vec3 (060.0, 188.0, 252.0));    '#10+'       TRY_COLOR (vec3 (188.0, 188.0, 188.0));    '#10+'       TRY_COLOR (vec3 (216.0, 248.0, 120.0));    '#10+'       TRY_COLOR (vec3 (248.0, 216.0, 120.0));    '#10+'       TRY_COLOR (vec3 (248.0, 164.0, 192.0));    '#10+'       TRY_COLOR (vec3 (000.0, 252.0, 252.0));    '#10+'       TRY_COLOR (vec3 (184.0, 184.0, 248.0));    '#10+'       TRY_COLOR (vec3 (184.0, 248.0, 184.0));    '#10+'       TRY_COLOR (vec3 (240.0, 208.0, 176.0));    '#10+'       TRY_COLOR (vec3 (248.0, 120.0, 248.0));    '#10+'       TRY_COLOR (vec3 (252.0, 224.0, 168.0));    '#10+'       TRY_COLOR (vec3 (184.0, 248.0, 216.0));    '#10+'       TRY_COLOR (vec3 (216.0, 184.0, 248.0));    '#10+'       TRY_COLOR (vec3 (164.0, 228.0, 252.0));    '#10+'       TRY_COLOR (vec3 (248.0, 184.0, 248.0));    '#10+'       TRY_COLOR (vec3 (248.0, 216.0, 248.0));    '#10+'       TRY_COLOR (vec3 (248.0, 248.0, 248.0));    '#10+'       TRY_COLOR (vec3 (252.0, 252.0, 252.0));  '#10+'       }                                          '#10+'                                                  '#10+'if(c_mode==5.0){                              '#10+'       TRY_COLOR (vec3 (156.0, 189.0, 015.0));    '#10+'       TRY_COLOR (vec3 (140.0, 173.0, 015.0));    '#10+'       TRY_COLOR (vec3 (048.0, 098.0, 048.0));    '#10+'       TRY_COLOR (vec3 (000.0, 000.0, 000.0));    '#10+'       }                                          '#10+'                                              '#10+'if(c_mode==6.0){                                '#10+'    TRY_COLOR (vec3 (000.0,000.0,000.0));     '#10+'    TRY_COLOR (vec3 (255.0,255.0,255.0));     '#10+'    TRY_COLOR (vec3 (255.0,  0.0,  0.0));     '#10+'    TRY_COLOR (vec3 (  0.0,255.0,  0.0));     '#10+'    TRY_COLOR (vec3 (  0.0,  0.0,255.0));     '#10+'    TRY_COLOR (vec3 (255.0,255.0,  0.0));     '#10+'    TRY_COLOR (vec3  (  0.0,255.0,255.0));    '#10+'    TRY_COLOR (vec3 (255.0,  0.0,255.0));     '#10+'    TRY_COLOR (vec3 (128.0,  0.0,  0.0));     '#10+'    TRY_COLOR (vec3 (  0.0,128.0,  0.0));     '#10+'    TRY_COLOR (vec3 (  0.0,  0.0,128.0));     '#10+'    TRY_COLOR (vec3 (128.0,128.0,  0.0));     '#10+'    TRY_COLOR (vec3 (  0.0,128.0,128.0));     '#10+'    TRY_COLOR (vec3 (128.0,  0.0,128.0));     '#10+'    TRY_COLOR (vec3 (128.0,128.0,128.0));     '#10+'    TRY_COLOR (vec3 (255.0,128.0,128.0));     '#10+'    }                                         '#10+'                                                '#10+'if(c_mode==7.0){                                '#10+'    TRY_COLOR (vec3 (000.0,000.0,000.0));     '#10+'    TRY_COLOR (vec3 (000.0,170.0,170.0));     '#10+'    TRY_COLOR (vec3 (170.0,000.0,170.0));     '#10+'    TRY_COLOR (vec3 (170.0,170.0,170.0));     '#10+'    }                                         '#10+'                                                '#10+'if(c_mode==8.0){                                '#10+'    TRY_COLOR ( vec3(000.0,000.0,000.0));     '#10+'    TRY_COLOR ( vec3(000.0,000.0,128.0));     '#10+'    TRY_COLOR ( vec3(000.0,000.0,255.0));     '#10+'    TRY_COLOR ( vec3(128.0,000.0,000.0));     '#10+'    TRY_COLOR ( vec3(128.0,000.0,128.0));     '#10+'    TRY_COLOR ( vec3(128.0,000.0,255.0));     '#10+'    TRY_COLOR ( vec3(255.0,000.0,000.0));     '#10+'    TRY_COLOR ( vec3(255.0,000.0,128.0));     '#10+'    TRY_COLOR ( vec3(255.0,000.0,255.0));     '#10+'    TRY_COLOR ( vec3(000.0,128.0,000.0));     '#10+'    TRY_COLOR ( vec3(000.0,128.0,128.0));     '#10+'    TRY_COLOR ( vec3(000.0,128.0,255.0));     '#10+'    TRY_COLOR ( vec3(128.0,128.0,000.0));     '#10+'    TRY_COLOR ( vec3(128.0,128.0,128.0));     '#10+'    TRY_COLOR ( vec3(128.0,128.0,255.0));     '#10+'    TRY_COLOR ( vec3(255.0,128.0,000.0));     '#10+'    TRY_COLOR ( vec3(255.0,128.0,128.0));     '#10+'    TRY_COLOR ( vec3(255.0,128.0,255.0));     '#10+'    TRY_COLOR ( vec3(000.0,255.0,000.0));     '#10+'    TRY_COLOR ( vec3(000.0,255.0,128.0));     '#10+'    TRY_COLOR ( vec3(000.0,255.0,255.0));     '#10+'    TRY_COLOR ( vec3(128.0,255.0,000.0));     '#10+'    TRY_COLOR ( vec3(128.0,255.0,128.0));     '#10+'    TRY_COLOR ( vec3(128.0,255.0,255.0));     '#10+'    TRY_COLOR ( vec3(255.0,255.0,000.0));     '#10+'    TRY_COLOR ( vec3(255.0,255.0,128.0));     '#10+'    TRY_COLOR ( vec3(255.0,255.0,255.0));     '#10+'    }                                         '#10+'                                                '#10+'if(c_mode==9.0){                                '#10+'     TRY_COLOR (vec3(0,0,0));                 '#10+'     TRY_COLOR ( vec3(85,0,0));               '#10+'     TRY_COLOR ( vec3(170,0,0));            '#10+'     TRY_COLOR ( vec3(255,0,0));              '#10+'      TRY_COLOR ( vec3(0,85,0));                '#10+'     TRY_COLOR ( vec3(85,85,0));              '#10+'     TRY_COLOR ( vec3(170,85,0));           '#10+'     TRY_COLOR ( vec3(255,85,0));             '#10+'      TRY_COLOR ( vec3(0,170,0));               '#10+'     TRY_COLOR ( vec3(85,170,0));             '#10+'     TRY_COLOR ( vec3(170,170,0));          '#10+'     TRY_COLOR ( vec3(255,170,0));            '#10+'      TRY_COLOR ( vec3(0,255,0));               '#10+'     TRY_COLOR ( vec3(85,255,0));             '#10+'     TRY_COLOR ( vec3(170,255,0));          '#10+'     TRY_COLOR ( vec3(255,255,0));            '#10+'      TRY_COLOR ( vec3(0,0,85));                '#10+'     TRY_COLOR ( vec3(85,0,85));              '#10+'     TRY_COLOR ( vec3(170,0,85));           '#10+'     TRY_COLOR ( vec3(255,0,85));             '#10+'      TRY_COLOR ( vec3(0,85,85));               '#10+'        TRY_COLOR ( vec3(85,85,85));              '#10+'        TRY_COLOR ( vec3(170,85,85));             '#10+'     TRY_COLOR ( vec3(255,85,85));            '#10+'     TRY_COLOR ( vec3(0,170,85));             '#10+'   TRY_COLOR ( vec3(85,170,85));            '#10+'        TRY_COLOR ( vec3(170,170,85));            '#10+'     TRY_COLOR ( vec3(255,170,85));           '#10+'     TRY_COLOR ( vec3(0,255,85));           '#10+'     TRY_COLOR ( vec3(85,255,85));            '#10+'      TRY_COLOR ( vec3(170,255,85));            '#10+'        TRY_COLOR ( vec3(255,255,85));            '#10+'        TRY_COLOR ( vec3(0,0,170));               '#10+'     TRY_COLOR ( vec3(85,0,170));           '#10+'     TRY_COLOR ( vec3(170,0,170));            '#10+'   TRY_COLOR ( vec3(255,0,170));            '#10+'        TRY_COLOR ( vec3(0,85,170));              '#10+'     TRY_COLOR ( vec3(85,85,170));            '#10+'     TRY_COLOR ( vec3(170,85,170));           '#10+'   TRY_COLOR ( vec3(255,85,170));           '#10+'        TRY_COLOR ( vec3(0,170,170));             '#10+'        TRY_COLOR ( vec3(85,170,170));            '#10+'        TRY_COLOR ( vec3(170,170,170));           '#10+'     TRY_COLOR ( vec3(255,170,170));          '#10+'     TRY_COLOR ( vec3(0,255,170));          '#10+'     TRY_COLOR ( vec3(85,255,170));           '#10+'      TRY_COLOR ( vec3(170,255,170));           '#10+'     TRY_COLOR ( vec3(255,255,170));          '#10+'     TRY_COLOR ( vec3(0,0,255));            '#10+'     TRY_COLOR ( vec3(85,0,255));             '#10+'      TRY_COLOR ( vec3(170,0,255));             '#10+'     TRY_COLOR ( vec3(255,0,255));            '#10+'        TRY_COLOR ( vec3(0,85,255));              '#10+'     TRY_COLOR ( vec3(85,85,255));            '#10+'     TRY_COLOR ( vec3(170,85,255));           '#10+'      TRY_COLOR ( vec3(255,85,255));            '#10+'        TRY_COLOR ( vec3(0,170,255));             '#10+'     TRY_COLOR ( vec3(85,170,255));           '#10+'     TRY_COLOR ( vec3(170,170,255));          '#10+'        TRY_COLOR ( vec3(255,170,255));           '#10+'        TRY_COLOR ( vec3(0,255,255));             '#10+'     TRY_COLOR ( vec3(85,255,255));           '#10+'     TRY_COLOR ( vec3(170,255,255));          '#10+'        TRY_COLOR ( vec3(255,255,255));           '#10+'    }                                         '#10+'if(c_mode==10.0){                               '#10+'       TRY_COLOR(vec3(0,0,0)*255.0);// black      '#10+'       TRY_COLOR(vec3(1,1,1)*255.0);// white      '#10+'       TRY_COLOR(vec3(0.41,0.22,0.17)*255.0);     '#10+'       TRY_COLOR(vec3(0.44,0.64,0.70)*255.0);     '#10+'       TRY_COLOR(vec3(0.44,0.24,0.53)*255.0);     '#10+'       TRY_COLOR(vec3(0.35,0.55,0.26)*255.0);     '#10+'       TRY_COLOR(vec3(0.21,0.16,0.47)*255.0);     '#10+'       TRY_COLOR(vec3(0.72,0.78,0.44)*255.0);     '#10+'       TRY_COLOR(vec3(0.44,0.31,0.15)*255.0);     '#10+'       TRY_COLOR(vec3(0.26,0.22,0.00)*255.0);     '#10+'       TRY_COLOR(vec3(0.60,0.40,0.35)*255.0);     '#10+'       TRY_COLOR(vec3(0.27,0.27,0.27)*255.0);     '#10+'       TRY_COLOR(vec3(0.42,0.42,0.42)*255.0);     '#10+'       TRY_COLOR(vec3(0.60,0.82,0.52)*255.0);     '#10+'       TRY_COLOR(vec3(0.42,0.37,0.71)*255.0);     '#10+'       TRY_COLOR(vec3(0.58,0.58,0.58)*255.0);     '#10+'       }                                          '#10+'if(c_mode==11.0){                             '#10+'       TRY_COLOR(vec3(0,0,0));// black            '#10+'       TRY_COLOR(vec3(0,0,255.0));// bluez80      '#10+'       TRY_COLOR(vec3(0,0,192.0));// bluez80      '#10+'       TRY_COLOR(vec3(255.0,0,0));                '#10+'       TRY_COLOR(vec3(192.0,0,0));                '#10+'       TRY_COLOR(vec3(255.0,0,255.0));            '#10+'       TRY_COLOR(vec3(192.0,0,192.0));          '#10+'       TRY_COLOR(vec3(0,255.0,0));                '#10+'       TRY_COLOR(vec3(0,192.0,0));                '#10+'       TRY_COLOR(vec3(0,255.0,255.0));            '#10+'       TRY_COLOR(vec3(0,192.0,192.0));            '#10+'       TRY_COLOR(vec3(255.0,255.0,0));            '#10+'       TRY_COLOR(vec3(192.0,192.0,0));            '#10+'       TRY_COLOR(vec3(255.0,255.0,255.0));        '#10+'       TRY_COLOR(vec3(192.0,192.0,192.0));        '#10+'                                                      '#10+'       }                                          '#10+'                                                  '#10+'if(c_mode==12.0){                               '#10+'     TRY_COLOR(vec3(0,0,0));// black            '#10+'       TRY_COLOR(vec3(62.0, 184.0,73.0));         '#10+'       TRY_COLOR(vec3(116.0, 208.0, 125.0));      '#10+'       TRY_COLOR(vec3(89.0, 85.0, 224.0));        '#10+'       TRY_COLOR(vec3(128.0, 118.0, 241.0));      '#10+'       TRY_COLOR(vec3(185.0, 94.0, 81.0));        '#10+'       TRY_COLOR(vec3(101.0, 219.0, 239.0));      '#10+'       TRY_COLOR(vec3(219.0, 101.0, 89.0));       '#10+'       TRY_COLOR(vec3(255.0, 137.0, 125.0));      '#10+'       TRY_COLOR(vec3(204.0, 195.0, 94.0));       '#10+'       TRY_COLOR(vec3(222.0, 208.0, 135.0));      '#10+'       TRY_COLOR(vec3(58.0, 162.0, 65.0));        '#10+'       TRY_COLOR(vec3(183.0, 102.0, 181.0));      '#10+'       TRY_COLOR(vec3(204.0, 204.0, 204.0));      '#10+'       TRY_COLOR(vec3(255.0, 255.0, 255.0));      '#10+'       }                                        '#10+   'return old ;                                                                          '#10+'}                                                                                   '#10+ 'vec3 dither (vec3 color, vec2 uv) {                                               '#10+'       color *= 255.0 * intensity;                                               '#10+'       //color += dither_matrix (mod (uv.x, 8.0), mod (uv.y, 8.0)) ;                '#10+'       color = find_closest (clamp (color, 0.0, 255.0));                          '#10+'       return color / 255.0;                                                      '#10+'}                                                                                 '#10+  'void main()'#10 +'{'#10 +'vec2 uv =  texCoord.xy   ;            '#10+// flip y' uv.y = 1.-uv.y;                                           '#10+// resolution down'uv = floor(256.0*uv)/256.0;'#10+// texture xy_position//'    vec2  xy_pos = vec2(0.09,0.25);'#10+   '       vec3 tx = texture(tex, uv ).xyz;                            '#10+'       if(c_mode>=1.0)                                            '#10+'     gl_FragColor =  vec4 (dither (tx, uv ),1.0);               '#10+'     else                                                       '#10+'     gl_FragColor =  vec4 (tx ,1.0)* intensity;                          '#10+ '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  Fintensity := UniformSingle['intensity'];  FMode      := UniformSingle['c_mode'];  FImage0    := UniformInteger['tex'];  FCanvasSize := UniformPointF['canvasSize'];  FImage0V   := 0;  FTimer := 0;  FintensityV := 1.0;  FModeV := 1.0;  end;  procedure TBGLCMapShader.StartUse;begin  inherited StartUse;  FTime.Update;  FTime.Value:=FTimer;  FImage0.Update;  FImage0.Value:=FImage0V;  FIntensity.Update;  Fintensity.Value:= FintensityV;  FMode.Update;  FMode.Value:= FModeV;  end; function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin   previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;   previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;  end; procedure TBGLCMapShader.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(800,600);  Canvas.FillRect(0, 0, 800,600, CSSBlack);  Canvas.Lighting.ActiveShader := previousShader;end;end. ---------------------------------------------------------------------- Gigatron · 2024-08-15 23:22 Hi, Let's stay in the colors and try to use your own palette; For example use Pico-8 fantasy-console palette; Take the palette table  in RGB format, insert each RGB value in vector3(x,y,z) table and use the shader; Here is the code in shader; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // PICO-8'  if(c_mode==3.0){           '#10+'TRY_COLOR (vec3(0,0,0       ));'#10+'TRY_COLOR (vec3(29,43,83    ));'#10+'TRY_COLOR (vec3(126,37,83   ));'#10+'TRY_COLOR (vec3(0,135,81    ));'#10+'TRY_COLOR (vec3(171,82,54   ));'#10+'TRY_COLOR (vec3(95,87,79    ));'#10+'TRY_COLOR (vec3(194,195,199 ));'#10+'TRY_COLOR (vec3(255,241,232 ));'#10+'TRY_COLOR (vec3(255,0,77    ));'#10+'TRY_COLOR (vec3(255,163,0   ));'#10+'TRY_COLOR (vec3(255,236,39  ));'#10+'TRY_COLOR (vec3(0,228,54    ));'#10+'TRY_COLOR (vec3(41,173,255  ));'#10+'TRY_COLOR (vec3(131,118,156 ));'#10+'TRY_COLOR (vec3(255,119,168 ));'#10+'TRY_COLOR (vec3(255,204,170 ));'#10+'    } ---------------------------------------------------------------------- Gigatron · 2024-08-16 00:41 Let's end the night with a beautiful filter; mrharicot Bilateral Filter Shader; You can see the original image and the filtered result ; Main Unit; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls, BGRABitmap, BGRABitmapTypes, BGRABilateralFilter, BGLVirtualScreen,  BGRAOpenGL, BGRAText,BGRATextFX,  BGRAGradients,BGRAFontGL, RayLib ; // raylib unit; type   { TForm1 }   TForm1 = class(TForm)      BGLVirtualScreen1: TBGLVirtualScreen;      Button1: TButton;      Button2: TButton;      Button3: TButton;      Button4: TButton;      FloatSpinEdit1: TFloatSpinEdit;      OpenDialog1: TOpenDialog;    Timer1: TTimer;    procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;      ElapsedMs: integer);    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure Button1Click(Sender: TObject);    procedure Button2Click(Sender: TObject);    procedure Button3Click(Sender: TObject);    procedure Button4Click(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure FormPaint(Sender: TObject);    procedure Timer1Timer(Sender: TObject);     procedure LoadPicture();    private    cmap_shader: TBGLBilateralFilter;    GLBigFont: IBGLFont;    bigFont: TBGLRenderedFont;    public    texture0,gl_surface : IBGLTexture;    barreHaut,barreBas :IBGLTexture;   end; var  Form1: TForm1;  cmode : integer; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin   cmode := 0; end; procedure TForm1.FormPaint(Sender: TObject);begin end; procedure TForm1.Timer1Timer(Sender: TObject);begin  BGLVirtualScreen1.Invalidate; end; procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;  BGLContext: TBGLContext; ElapsedMs: integer); begin    // cmap_shader.Time := cmap_shader.Time +0.004;     cmap_shader.Cmode:=cmode;     cmap_shader.Intensity := FloatSpinEdit1.value;end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);  var bigRender: TBGRATextEffectFontRenderer;    shader : TPhongShading; begin   texture0     := BGLTexture(ResourceFile('girl512-5.png'));  // texture must power of TWO size !!   gl_surface := BGLTexture(ResourceFile('gl_surface.png'));    cmap_shader := TBGLBilateralFilter.Create(BGLContext.Canvas);   // les barres    barreHaut     := BGLTexture(ResourceFile('barre_haut.png'));    barreBas     := BGLTexture(ResourceFile('barre_bas.png'));    // font    shader := TPhongShading.Create;    shader.LightPosition := Point(10, 100);    shader.LightPositionZ:=20;    shader.AmbientFactor:=0.2;    shader.SpecularFactor:=1.0;    shader.LightSourceDistanceTerm := 200;    shader.LightColor:=BGRA(255,255,255,255);    bigRender := TBGRATextEffectFontRenderer.Create(shader, true);    bigFont  := TBGLRenderedFont.Create(bigRender, true);    bigFont.Name := 'Dynamic Recompilation';    bigFont.EmHeight := 24;    //bigFont.Style:=[fsBold];    GLBigFont := bigFont;  end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);begin      // le traitement du sampler2D comme texture   cmap_shader.Image0 := 0;     //cmap_shader.Intensity:= 1.0;     gl_surface := cmap_shader.Render(texture0);   // container de l'image0 affichee par le shader     BGLContext.Canvas.PutImage(0,0,texture0,BGRA(255,255,255,255));     BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);      BGL Context.Canvas.PutImage(0,558,barreBas,BGRA(255,255,255,255)); end; pr ocedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin      // libere les textures et le shader !!  texture0    := nil;  gl_surface := nil;  GLBigFont := nil;  barreHaut:= nil;  barreBas := nil;  FreeAndNil(cmap_shader);    FreeAndNil(cmap_shader);  end; procedure TForm1.Button1Click(Sender: TObject);begin      LoadPicture();end; procedure TForm1.Button2Click(Sender: TObject);begin end;  procedure TForm1.Button3Click(Sender: TObject);begin    cmode := 1;end; procedure TForm1.Button4Click(Sender: TObject);begin      cmode := 0;end; procedure TForm1.LoadPicture; begin        if (OpenDialog1.Execute) then        begin        texture0 := BGLTexture(ResourceFile(OpenDialog1.FileName));         end;end;  end.  Shader Unit; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception unit BGRABilateralFilter; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type   TBGLBilateralFilter = class(TBGLShader3D)   private   function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    // time    FTime: TUniformVariableSingle;    FTimer : Single;    // intensity    Fintensity  : TUniformVariableSingle;    FintensityV : Single;    // Color mode    FMode  : TUniformVariableSingle;    FModeV : Single;     FImage0: TUniformVariableInteger;    FImage0V : Integer;     FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;    procedure RenderOnCanvas;    // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Intensity :  Single read FintensityV  write FintensityV;    property Cmode :  Single read FModeV  write FModeV ;      property Image0: integer read FImage0V write FImage0V;     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;    end; implementation function TBGLBilateralFilter.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLBilateralFilter.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLBilateralFilter } constructor TBGLBilateralFilter.Create(ACanvas: TBGLCustomCanvas); begin// vertexinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +' // gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +'}', // fragment shader'//out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform sampler2D tex;'#10+'uniform float intensity;                      '#10+'uniform float c_mode;                         '#10+ // mrharicot Bilateral Filter'#define SIGMA 10.0                                           '#10+'#define BSIGMA 0.2                                           '#10+'#define MSIZE 15                                             '#10+'                                                             '#10+'float normpdf(in float x, in float sigma)                      '#10+'{                                                            '#10+'       return 0.39894*exp(-0.5*x*x/(sigma*sigma))/sigma;       '#10+'}                                                            '#10+'                                                             '#10+'float normpdf3(in vec3 v, in float sigma)                      '#10+'{                                                            '#10+'       return 0.39894*exp(-0.5*dot(v,v)/(sigma*sigma))/sigma;  '#10+'}                                                            '#10+   'void main()'#10 +'{'#10 +'vec2 uv =  texCoord.xy   ;            '#10+// flip y//'// uv.y = 1.-uv.y;                                           '#10+// resolution down//'uv = floor(256.0*uv)/256.0;'#10+// texture xy_position//'    vec2  xy_pos = vec2(0.09,0.25);'#10+ 'vec3 c = texture2D(tex,gl_FragCoord.xy/512.0).rgb;                       '#10+'if (c_mode==0.0)                                                                                     '#10+' {                                                                                                 '#10+'       gl_FragColor = vec4(c, 1.0);                                                                  '#10+'                                                                                                   '#10+' } else {                                                                                            '#10+'                                                                                                   '#10+'//declare stuff                                                                                      '#10+'const int kSize = (MSIZE-1)/2;                                                                       '#10+'float kernel[MSIZE];                                                                                 '#10+'vec3 final_colour = vec3(0.0);                                                                       '#10+'                                                                                                     '#10+'//create the 1-D kernel                                                                              '#10+'float Z = 0.0;                                                                                     '#10+'for (int j = 0; j <= kSize; ++j)                                                                     '#10+'{                                                                                                  '#10+'kernel[kSize+j] = kernel[kSize-j] = normpdf(float(j), SIGMA);                                          '#10+'}                                                                                                  '#10+'                                                                                                     '#10+'                                                                                                   '#10+'       vec3 cc;                                                                                      '#10+'     float factor;                                                                                 '#10+'       float bZ = 1.0/normpdf(0.0, intensity);                                                            '#10+'       //read out the texels                                                                         '#10+'       for (int i=-kSize; i <= kSize; ++i)                                                           '#10+'       {                                                                                             '#10+'               for (int j=-kSize; j <= kSize; ++j)                                                   '#10+'       {                                                                                             '#10+'       cc = texture2D(tex, (gl_FragCoord.xy+vec2(float(i),float(j)))/512.0 ).rgb;    '#10+'       factor = normpdf3(cc-c, intensity)*bZ*kernel[kSize+j]*kernel[kSize+i];                           '#10+'       Z += factor;                                                                                  '#10+'       final_colour += factor*cc;                                                                    '#10+'                                                                                                     '#10+'               }                                                                                   '#10+'       }                                                                                             '#10+'                                                                                                   '#10+'                                                                                                     '#10+'       gl_FragColor = vec4(final_colour/Z, 1.0);                                                     '#10+'}                                                                                                    '#10+  '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  Fintensity := UniformSingle['intensity'];  FMode      := UniformSingle['c_mode'];  FImage0    := UniformInteger['tex'];  FCanvasSize := UniformPointF['canvasSize'];  FImage0V   := 0;  FTimer := 0;  FintensityV := 0.1;  FModeV := 1.0;  end;  procedure TBGLBilateralFilter.StartUse;begin  inherited StartUse;  FTime.Update;  FTime.Value:=FTimer;  FImage0.Update;  FImage0.Value:=FImage0V;  FIntensity.Update;  Fintensity.Value:= FintensityV;  FMode.Update;  FMode.Value:= FModeV;  end; function TBGLBilateralFilter.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin   previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;// in case comment the two next line, if you not want to see black rectangle !!  //----------------------------------------------------------------- // Canvas.Fill(BGRAPixelTransparent);  // Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);  //-----------------------------------------------------------------  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;   // canvas renderer  //previousBuf := Canvas.ActiveFrameBuffer;  //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  //Canvas.ActiveFrameBuffer := buf;  //Canvas.Fill(BGRAPixelTransparent);  //RenderOnCanvas;  //Canvas.ActiveFrameBuffer := previousBuf;  //result := buf.MakeTextureAndFree; end; procedure TBGLBilateralFilter.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(800,600);  Canvas.FillRect(0, 0, 800,600, CSSBlack);  Canvas.Lighting.ActiveShader := previousShader;end;end. ---------------------------------------------------------------------- circular · 2024-08-17 20:27 That's a neat filter, making the gradient smooth but not making the image blurry! ---------------------------------------------------------------------- Gigatron · 2024-08-19 16:39 Nice Today i'am trying to Blend 2 texture with BGRA fragment shader and use Photoshop Blend mode , original shader by 'BEN' ; Gfx by JCS and WWW ; SFX by (zalza.of.cs-p&t q l). Right now don't know if the blend mode are accurate ! DARKEN, MULTIPLY, COLOR BURN, LINEAR BURN, DARKER COLOR, LIGHTEN, SCREEN, COLOR DODGE, LINEAR DODGE, LIGHTER COLOR, OVERLAY, SOFTLIGHT, HARDLIGHT, VIVIDLIGHT, LINEARLIGHT, PINLIGHT, HARDMIX, DIFFERENCE, EXCLUSION, SUBSTRACT, DIVIDE, HUE, COLOR, SATURATION, LUMINOSITY  Flag shader by me ; Demo on YT : https://www.youtube.com/watch?v=-_nefMWTPAA The code is attached to .zip file ; the size is over 20000 chars !!! Since I play with opengl an error often appears. I hope it's not my ***** nvidia gtx 1080 card, someone had the same error ? ---------------------------------------------------------------------- Gigatron · 2024-08-20 15:59 Hi, Let's Try to make a nice fx with glsl shader a sort of procedural map; Finally YT; https://www.youtube.com/watch?v=sACgqLq2Dws The Main Unit  : Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls, BGRABitmap, BGRABitmapTypes, BGRABilateralFilter, BGLVirtualScreen,  BGRAOpenGL, BGRAText,BGRATextFX,  BGRAGradients,BGRAFontGL, RayLib , // raylib unit; BGRAOpenGL3D,   BGRACanvasGL, BGRAOpenGLType; type   { TForm1 }   TForm1 = class(TForm)      BGLVirtualScreen1: TBGLVirtualScreen;    Button4: TButton;      OpenDialog1: TOpenDialog;    Timer1: TTimer;    procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;      ElapsedMs: integer);    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);     procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);    private    cmap_shader: TBGLBilateralFilter;    GLBigFont: IBGLFont;    bigFont: TBGLRenderedFont;    public    texture0,gl_surface,barreBas,copper : IBGLTexture;   end; var  Form1: TForm1;  cmode,tm : integer;  music:TMusic;  master_vol : single;  s_sin  : single;  b_mode : Array[0..26] Of String =('THE PROCEDURAL MAP BGRA',                                    'BGRA GL SHADER',                                  'IN ACTION',                                  '***********************',                                    'DEMO PROGRAMMED BY ',                                    'GIGATRON ON 18/08/2024',                                    '***********************',                                    'WE CAN DO REAL',                                    'INTERESTING DEMO',                                  'AND A MILLION OF ',                                  'DIFFERENT FX WITH THE',                                  'NEW BGRA VERSION',                                    'GREETINGS TO CIRCULAR',                                    'FOR THE BGRA COMPONENT',                                    'GUVACODE RAYLAZ COMPONENT',                                    'MY LOVE     *************',                                    'THE LAZARUS FPC STAFF',                                    'MEMBERS OF SUB QUANTUM TECH',                                    'BLIZZARD RAZOR-1911 PARADOX',                                    'SUB-SERO TBL BRONX HOTLINE',                                    'ANTI BYTE OFFA SIM MEGAFORCE',                                    'PHENOMENA NORT-STAR TRISTAR',                                    'COMPLEX TRISTAR RED- SECTOR',                                    'WARM STAR SQUAZAR HQC DEFJAM',                                    'XDT FOR THE GREAT MODULE',                                    'AND ALL I FORGOT AROUND',                                    'WE ARE NOT ALONE !!!'); implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin   cmode := 0;  tm :=0;    // Initialization audio + load module  InitAudioDevice();  music := LoadMusicStream(PChar(GetApplicationDirectory + 'noname.mod'));    // xm module  master_vol := 0;  music.looping := true;  PlayMusicStream(music); end; procedure TForm1.FormDestroy(Sender: TObject);begin   // De-Initialization UnloadMusicStream(music);  // Unload music stream buffers from RAM CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)end; procedure TForm1.Timer1Timer(Sender: TObject);begin inc(tm); s_sin := s_sin +0.04; if (tm>100) then begin   cmode := cmode +1;   tm :=0;   if (cmode>=27) then cmode :=0; end; BGLVirtualScreen1.Invalidate;end; procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;BGLContext: TBGLContext; ElapsedMs: integer); begin     cmap_shader.Time := cmap_shader.Time +0.028;     cmap_shader.Cmode:= cmode;     Button4.Caption := ' ' + b_mode[cmode] + ' ';     Button4.Width:= 28*b_mode[cmode].Length;     Button4.Left := 10;    // cmap_shader.Intensity := 2.0;     SetMasterVolume(master_vol);     if( master_vol<1.0) then master_vol := master_vol + 0.01;      Upda]"]>BlockedsicStream(music);end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);  var bigRender: TBGRATextEffectFontRenderer;      shader : TPhongShading;  begin   texture0     := BGLTexture(ResourceFile('m01.png'));  // texture must power of TWO size 512*512!!   gl_surface := BGLTexture(ResourceFile('gl_surface.png'));   copper := BGLTexture(ResourceFile('cop_23.png'));     cmap_shader := TBGLBilateralFilter.Create(BGLContext.Canvas  );    // les barres    barreBas     := BGLTexture(ResourceFile('barre_bas.png'));    // font    shader := TPhongShading.Create;    shader.LightPosition := Point(10, 400);    shader.LightPositionZ:= 150;    shader.AmbientFactor := 0.2;    shader.SpecularFactor := 0.2;     shader.LightColor:=BGRA(50,155,255,255);    bigRender := TBGRATextEffectFontRenderer.Create(shader, true);    bigFont  := TBGLRenderedFont.Create(bigRender, true);    bigFont.Name := 'fairlight';    bigFont.EmHeight := 48;    bigFont.Color:=BGRA(0,190,255,255);    //bigFont.Style:=[fsBold];    GLBigFont := bigFont; end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;BGLContext: TBGLContext); begin     BGLContext.Canvas.PutImage(0,520- 480*abs(sin(s_sin))*0.8,copper,255);     // le traitement du sampler2D comme texture     cmap_shader.Image0 := 0;     cmap_shader.Image1 := 1;     //cmap_shader.Intensity:= 1.0;     gl_surface := cmap_shader.Render(texture0);   // container de l'image0 affichee par le shader     BGLContext.Canvas.StretchPutImage(175,0,460 ,600, gl_surface);     bigFont.TextOut(40,5,'GIGATRON 18/08/2024');     BGLContext.Canvas.PutImage(0,555,barreBas,255); end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;BGLContext: TBGLContext);begin      // libere les textures et le shader !!  texture0   := nil;  copper     := nil;  gl_surface := nil;  GLBigFont := nil;  barreBas := nil;  FreeAndNil(cmap_shader);end;  end.  Shader unit : Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception unit BGRABilateralFilter; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type   TBGLBilateralFilter = class(TBGLShader3D)   private   function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    // time    FTime: TUniformVariableSingle;    FTimer : Single;    // intensity    Fintensity  : TUniformVariableSingle;    FintensityV : Single;    // Color mode    FMode  : TUniformVariableInteger;    FModeV : Integer;     FImage0: TUniformVariableInteger;    FImage0V : Integer;    FImage1: TUniformVariableInteger;    FImage1V : Integer;      FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;     // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Intensity :  Single read FintensityV  write FintensityV;    property Cmode :  integer read FModeV  write FModeV ;     property Image0: integer read FImage0V write FImage0V;    property Image1: integer read FImage1V write FImage1V;   // second texture if needed !     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;    end; implementation function TBGLBilateralFilter.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLBilateralFilter.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLBilateralFilter } constructor TBGLBilateralFilter.Create(ACanvas: TBGLCustomCanvas); begin// vertexinherited Create(ACanvas, 'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +' // gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +'}', // fragment shader'//out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform sampler2D tex0;'#10+'uniform sampler2D tex1;'#10+'uniform float intensity;                      '#10+'uniform int c_mode;                           '#10+  'vec3 hsv2rgb(vec3 c){                           '#10+'                                                '#10+'vec4 K=vec4(1.0,2.0/3.0,1.0/3.0,3.0);             '#10+'vec3 p=abs(fract(c.xxx+K.xyz)*6.0-K.www);         '#10+'return c.z*mix(K.xxx,clamp(p-K.xxx,0.0,1.0),c.y); '#10+'}                                               '#10+ 'float luminance(vec3 col){                      '#10+'return dot(col,vec3(0.299,0.587,0.114));          '#10+'}                                                 '#10+ 'float texelHeight(vec4 rgba){                     '#10+'return luminance(rgba.rgb);                       '#10+'}                                               '#10+ 'vec3 cross_emu(vec3 x, vec3 y) {           '#10+'   return vec3(                              '#10+'     x[1] * y[2] - y[1] * x[2],            '#10+'       x[2] * y[0] - y[2] * x[0],            '#10+'       x[0] * y[1] - y[0] * x[1]);         '#10+'}                                            '#10+   'void main()'#10+'{'#10 +'vec2 uv =  texCoord.xy   ;            '#10+// flip y' uv.y = 1.-uv.y;                      '#10+// resolution down//'uv = floor(256.0*uv)/256.0;           '#10+// texture xy_position//'vec2  xy_pos = vec2(0.5,0.0);'#10+//'uv = floor(256.*uv)/256.0;                                  '#10+//Normalmapstrength'float normal_strength=7.0;                                                               '#10+ 'float height_multiplier=2.0;                                                             '#10+'float texel_offset=3.5;                                                                    '#10+ 'vec3 offset=vec3(texel_offset/512.0,texel_offset/512.0,0.0);                                         '#10+ 'vec3 surfaceColor= texture2D(tex0,uv).rgb;                                                       '#10+'float height=texelHeight(surfaceColor.rgbb)*height_multiplier;                                 '#10+'vec3 worldPosition=vec3(uv,height);                                                            '#10+ 'float ddX= texelHeight(texture2D(tex0,uv+offset.xz))- texelHeight(texture2D(tex0,uv-offset.xz));  '#10+'float ddY= texelHeig ht(texture2D(tex0,uv+offset.zy))-texelHeight(texture2D(tex0,uv- offset.zy));  '#10+ 'ddX *=normal_strength/texel_offset;                                                            '#10+'ddY *=normal_strength/texel_offset;                                                            '#10+ 'vec3 tangent=normalize(vec3(1.0,0.0,ddX));                                                     '#10+'vec3 bitangent=normalize(vec3(0.0,1.0,ddY));                                                   '#10+'vec3 normal=cross_emu(tangent,bitangent);                                                          '#10+ 'vec2 lightPosition=0.5+0.4*vec2(cos(time),sin(time));                                          '#10+'vec3 lightColor=hsv2rgb(vec3(mod(time*0.1,1.0),0.1,1.0));                                      '#10+ 'float lightStrength=10.0;                                                                      '#10+'float lightHeight=2.8;                                                                         '#10+ 'vec3 lightDir=normalize(vec3(lightPosition,lightHeight)-worldPosition);                        '#10+'float attenuation=lightStrength/pow(distanc e(lightPosition,uv)+lightHeight,2.0);                 '#10+'float lambert=max(0.0,dot(lightDir,normal));                                                   '#10+'float blinnPhong=pow(max(dot(normalize(vec3( vec3(0.0,0.0,1.0))+normal),lightDir),0.0),10.0);     '#10+ 'float ambient =0.0;                                                                            '#10+'float diff  =0.2*lambert;                                                                      '#10+'float specular =0.5*blinnPhong;                                                                '#10+'vec3 col = vec3(ambient+(diff*surfaceColor+specular))*attenuation*lightColor;                  '#10+'float luma=luminance(col);                                                                     '#10+ 'luma*=3.5;                                                                                   '#10+ 'col /= luma/(luma+1.0);                                                                      '#10+    ' gl_FragColor = vec4(col, 1.0);                         '#10+   '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  Fintensity := UniformSingle['intensity'];  FMode      := UniformInteger['c_mode'];  FImage0    := UniformInteger['tex0'];  FImage1    := UniformInteger['tex1'];  FCanvasSize := UniformPointF['canvasSize'];  FImage0V   := 0;  FImage1V   := 1;  FTimer := 0;  FintensityV := 0.1;  FModeV := 0;  end;  procedure TBGLBilateralFilter.StartUse;begin  inherited StartUse;  FTime.Update;  FTime.Value:=FTimer;  FImage0.Update;  FImage0.Value:=FImage0V;  FImage1.Update;  FImage1.Value:=FImage1V;   FIntensity.Update;  Fintensity.Value:= FintensityV;  FMode.Update;  FMode.Value:= FModeV;  end; function TBGLBilateralFilter.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin   previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;// in case comment the two next line, if you not want to see black rectangle !!  //-----------------------------------------------------------------//  Canvas.Fill(BGRAPixelTransparent);//  Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);  //-----------------------------------------------------------------  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;//  BTexture.Bind(1);  ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree; end; end. ---------------------------------------------------------------------- Gigatron · 2024-08-21 15:15 And one last shader, BGRA Gl lens shader demo example; Texure : WWW Sfx :    dream weaver / Aurora YT : https://www.youtube.com/watch?v=lHe11_2K8bo Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls, BGRABitmap, BGRABitmapTypes, BGRABilateralFilter, BGLVirtualScreen,  BGRAOpenGL, BGRAText,BGRATextFX,  BGRAGradients,BGRAFontGL, RayLib , // raylib unit; BGRAOpenGL3D,   BGRACanvasGL, BGRAOpenGLType; type   { TForm1 }   TForm1 = class(TForm)      BGLVirtualScreen1: TBGLVirtualScreen;    OpenDialog1: TOpenDialog;    Timer1: TTimer;    procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;    ElapsedMs: integer);    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);     procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);    private    cmap_shader: TBGLBilateralFilter;    GLBigFont: IBGLFont;     bigFont: TBGLRenderedFont;    public    texture0,texture1,gl_surface : IBGLTexture;    barreHaut,barreBas :IBGLTexture;   end; var  Form1: TForm1;  cmode,tm : integer;  music:TMusic;  master_vol : single;  implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin   cmode := 0;  tm :=0;    // Initialization audio + load module  InitAudioDevice();  music := LoadMusicStream(PChar(GetApplicationDirectory + 'fletch.mod'));    // module nightlight  master_vol := 0;  music.looping := true;  PlayMusicStream(music); end; procedure TForm1.FormDestroy(Sender: TObject);begin   // De-Initialization UnloadMusicStream(music);  // Unload music stream buffers from RAM CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)end; procedure TForm1.Timer1Timer(Sender: TObject);begin  inc( tm);   BGLVirtualScreen1.Invalidate; end; procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;  BGLContext: TBGLContext; ElapsedMs: integer); begin     cmap_shader.Time := cmap_shader.Time +0.038;     cmap_shader.Cmode:= cmode;     // cmap_shader.Intensity := 2.0;     SetMasterVolume(master_vol);     if( master_vol<1.0) then master_vol := master_vol + 0.01;      Upda]"]>BlockedsicStream(music);end; procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);  var bigRender: TBGRATextEffectFontRenderer;    shader : TPhongShading;  begin   texture0     := BGLTexture(ResourceFile('girl512-8.png'));  // texture must power of TWO size !!   texture1     := BGLTexture(ResourceFile('gtr.png'));   gl_surface := BGLTexture(ResourceFile('gl_surface.png'));     cmap_shader := TBGLBilateralFilter.Create(BGLContext.Canvas  );    // les barres    barreHaut     := BGLTexture(ResourceFile('barre_haut.png'));    barreBas     := BGLTexture(ResourceFile('barre_bas.png'));    // font    shader := TPhongShading.Create;    shader.LightPosition := Point(10, 400);    shader.LightPositionZ:= 150;    shader.AmbientFactor := 0.2;    shader.SpecularFactor := 0.2;     shader.LightColor:=BGRA(255,255,255,255);    bigRender := TBGRATextEffectFontRenderer.Create(shader, true);    bigFont  := TBGLRenderedFont.Create(bigRender, true);    bigFont.Name := 'paranoimia';    bigFont.EmHeight := 48;    //bigFont.Style:=[fsBold];    GLBigFont := bigFont; end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext); begin     //  BGLContext.Canvas.Lighting.ActiveShader := cmap_shader;     // le traitement du sampler2D comme texture     cmap_shader.Image0 := 0;     cmap_shader.Image1 := 1;     //cmap_shader.Intensity:= 1.0;     gl_surface := cmap_shader.Render(texture0,texture1);   // container de l'image0 affichee par le shader     BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);   //  bigFont.TextOut(0,5,'GIGATRON 15/08/2024');   //  BGLContext.Canvas.PutImage(0,558,barreBas,255);  end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin      // libere les textures et le shader !!  texture0    := nil;  texture1    := nil;  gl_surface := nil;  GLBigFont := nil;  barreHaut:= nil;  barreBas := nil;  FreeAndNil(cmap_shader);end;  end.  Shader Unit Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception unit BGRABilateralFilter; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type   TBGLBilateralFilter = class(TBGLShader3D)   private   function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    // time    FTime: TUniformVariableSingle;    FTimer : Single;    // intensity    Fintensity  : TUniformVariableSingle;    FintensityV : Single;    // Color mode    FMode  : TUniformVariableInteger;    FModeV : Integer;     FImage0: TUniformVariableInteger;    FImage0V : Integer;    FImage1: TUniformVariableInteger;    FImage1V : Integer;      FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture,BTexture: IBGLTexture): IBGLTexture; overload;    procedure RenderOnCanvas;    // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Intensity :  Single read FintensityV  write FintensityV;    property Cmode :  integer read FModeV  write FModeV ;      property Image0: integer read FImage0V write FImage0V;    property Image1: integer read FImage1V write FImage1V;     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;    end;   var  s_sin : single; implementation function TBGLBilateralFilter.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLBilateralFilter.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLBilateralFilter } constructor TBGLBilateralFilter.Create(ACanvas: TBGLCustomCanvas); begin// vertexinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +' // gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +'}', // fragment shader'uniform float pixelWidth;                              '#10+'uniform float pixelHeight;                              '#10+'vec2 iResolution = vec2( 1./pixelWidth, 1./pixelHeight); '#10+'//out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform sampler2D img0;'#10+'uniform sampler2D img1;'#10+'uniform float intensity;                        '#10+'uniform int c_mode;                           '#10+  // Flag fx Gigatron 'void main()'#10 +'{'#10 +'vec2 uv =  texCoord.xy   ;          '#10+// flip y' uv.y = 1.-uv.y;                      '#10+// resolution down'//uv = floor(256.0*uv)/256.0;           '#10+// texture xy_position//'    vec2  xy_pos = vec2(0.09,0.25);'#10+ 'float radius = 0.3  ;                                                                       '#10+'float zoom = 0.15 ;                                                                       '#10+' vec2 offset = vec2(0.5 * cos(time * 0.5), 0.50 * sin(time))*0.5,                              '#10+ '      center = uv - vec2(0.50+offset.x,0.5+offset.y) ;                                               '#10+'       center.x *= 512.0 / 512.0+0.33;                                                   '#10+'                                                                                                    '#10+' float dist = length(center);                                                                       '#10+' if (dist > radius) {                                                                               '#10+'       gl_FragColor = texture2D(img0, uv);                                                  '#10+'     return;                                                                                        '#10+' }                                                                                                '#10+' //input                                                                                            '#10+' vec2 m = vec2(0.5,0.25);                                                                           '#10+' //light                                                                                            '#10+' vec3 lightLoc = vec3(m.x, m.y, radius),                                                            '#10+'     lightLocDelta = normalize(vec3(offset - center,0.) - lightLoc),                                '#10+'     lightDir = vec3(lightLocDelta.xy, -sqrt(1. - pow(lightLocDelta.x,2.) - pow(lightLocDelta.y,2.))),'#10+'     normal = normalize(vec3(center, sqrt(pow(radius,2.) - pow(center.x,2.) - pow(center.y,2.)))),    '#10+'     bounce = reflect(lightDir, normal);                                                              '#10+' //diffuse light                                                                                    '#10+' float brightness = clamp(bounce.z, 0., 1.);                                                        '#10+' //dark effect                                                                                      '#10+' bounce = reflect(vec3(lightDir.xy, -lightDir.z), normal);                                          '#10+' float brightness2 = 1.7 - clamp(pow(bounce.z, 3.), 0., 1.);                                        '#10+' gl_FragColor = texture2D(img0, normal.xy * (zoom/normal.z) +  vec2(0.50+offset.x, 0.5+offset.y))                '#10+'     * vec4(clamp(abs(normal), 0.5, 1.), 1.)                                                        '#10+'     //falloff brightness with distance                                                             '#10+'   * clamp(brightness2 - (0.05/normal.z), 0., 1.)                                                 '#10+'     //add specular                                                                                 '#10+'     + vec4(pow(brightness, 10.));                                                                  '#10+  //'    gl_FragColor = vec4(tx1*tx0, 1.0);                         '#10+   '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  Fintensity := UniformSingle['intensity'];  FMode      := UniformInteger['c_mode'];  FImage0    := UniformInteger['img0'];  FImage1    := UniformInteger['img1'];  FCanvasSize := UniformPointF['canvasSize'];  FImage0V   := 0;  FImage1V   := 1;  FTimer := 0;  FintensityV := 0.1;  FModeV := 0;  end;  procedure TBGLBilateralFilter.StartUse;begin  inherited StartUse;  FTime.Update;  FTime.Value:=FTimer;  FImage0.Update;  FImage0.Value:=FImage0V;  FImage1.Update;  FImage1.Value:=FImage1V;   FIntensity.Update;  Fintensity.Value:= FintensityV;  FMode.Update;  FMode.Value:= FModeV;  end; function TBGLBilateralFilter.Render(ATexture,BTexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin   previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf;// in case comment the two next line, if you not want to see black rectangle !!  //-----------------------------------------------------------------  Canvas.Fill(BGRAPixelTransparent);   Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);  //-----------------------------------------------------------------  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  BTexture.Bind(1);  ATexture.Draw(0, 0);  BTexture.Draw(0+64*sin(s_sin), -420);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;   // canvas renderer  //previousBuf := Canvas.ActiveFrameBuffer;  //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  //Canvas.ActiveFrameBuffer := buf;  //Canvas.Fill(BGRAPixelTransparent);  //RenderOnCanvas;  //Canvas.ActiveFrameBuffer := previousBuf;  //result := buf.MakeTextureAndFree;   s_sin := s_sin +0.02;end; procedure TBGLBilateralFilter.RenderOnCanvas;var  previousShader: TBGLCustomShader;begin  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;  CanvasSize := PointF(800,600);  Canvas.FillRect(0, 0, 800,600, CSSBlack);  Canvas.Lighting.ActiveShader := previousShader; end;end. ---------------------------------------------------------------------- circular · 2024-08-23 14:13 The elegant lense effect, cool ---------------------------------------------------------------------- Gigatron · 2024-08-23 14:24 Quote from: circular on August 23, 2024, 04:13:59 pmThe elegant lense effect, cool  Thank you @circular  the result with video : https://www.youtube.com/watch?v=lHe11_2K8bo regards ---------------------------------------------------------------------- Gigatron · 2024-08-28 00:58 Hi, Here is another Amiga Style rotozoom example using BGRA GL fragment shader; Result on YT : https://www.youtube.com/watch?v=BL7Rm8o9lwA Main unit; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  StdCtrls, BGRABitmap, BGRABitmapTypes,   BGLVirtualScreen,  BGRAOpenGL, BGRAText,BGRATextFX,BGRARotozoom,  BGRAGradients,BGRAFontGL, raylib  ; // raylib unit;  type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;    ElapsedMs: integer);    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormDestroy(Sender: TObject);     procedure Timer1Timer(Sender: TObject);    procedure FormCreate(Sender: TObject);     private    roto_zoom_shader: TBGLRotozoom;    GLBigFont: IBGLFont;    bigFont: TBGLRenderedFont;    public    texture0,gl_surface : IBGLTexture;    barreHaut,barreBas :IBGLTexture;   end; var  Form1: TForm1;  music:TMusic;  master_vol : single;  alfa : byte;  message_index,alfa_time : integer;   message : Array[0..27] Of String =('  GIGATRON PRESENTS    ',                                   'BGRA GL ROTOZOOM SHADER',                                   '                       ',                                   ' SFX BY : MEGAWATT AND ',                                     '    THE SOUND LEGEND   ',                                     '***********************',                                     '   DEMO PROGRAMMED BY  ',                                     'GIGATRON ON 22/08/2024 ',                                     '***********************',                                     '                     ',                                     'GREETINGS LIST IN ORDER',                                     '   CIRCULAR FOR BGRA    ',                                     '    GUVACODE RAYLAZ   ',                                     '   RAYSAN FOR RAYLIB    ',                                   'ETOWNER, STATIC Z, DSR3 ',                                   'TONY, TRONIC DESIGN AND ',                                   '  PARALLAX, SUB-SERO    ',                                   '  THE LAZARUS FPC STAFF ',                                   '    SUB QUANTUM TECH    ',                                     '  BLIZZARD RAZOR-1911   ',                                     '   SUB- SERO TBL BRONX   ',                                     '   ANTI BYTE OFFA SIM   ',                                     '   PHENOMENA NORT- STAR  ',                                     '   COMPLEX  RED-SECTOR  ',                                     '    WARM STAR DEFJAM    ',                                   'AMIGA THE BEST COMPUTER ',                                   '     AND ALL THE REST   ',                                   '   WE ARE NOT ALONE !!! ');  implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  alfa :=0; message_index :=0; alfa_time :=0;   // Initialization audio + load module  InitAudioDevice();  music := LoadMusicStream(PChar(GetApplicationDirectory + 'abandon.xm'));    // module  master_vol := 0.0;  music.looping := true;  PlayMusicStream(music); end;  procedure TForm1.Timer1Timer(Sender: TObject);begin  roto_zoom_shader.Time:= roto_zoom_shader.Time +0.002;   if( alfa<255) then inc(alfa);  if(alfa>=255) then  begin    inc(alfa_time);    alfa :=255;    if (alfa_time>100) then    begin     alfa:=0;     inc(message_index);     alfa_time :=0;     if message_index >=28 then message_index :=0;    end;   end;   BGLVirtualScreen1.Invalidate; end;   procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);  var bigRender: TBGRATextEffectFontRenderer;    shader : TPhongShading; begin   texture0     := BGLTexture(ResourceFile('girl512-7.jpg'));  // texture must power of TWO size !!   gl_surface := BGLTexture(ResourceFile('gl_surface.jpg'));     roto_zoom_shader := TBGLRotozoom.Create(BGLContext.Canvas );   // les barres    barreHaut   := BGLTexture(ResourceFile('barre_haut.png'));    barreBas     := BGLTexture(ResourceFile('barre_bas.png'));    // font    shader := TPhongShading.Create;    shader.LightPosition := Point(10, 100);    shader.LightPositionZ:=10;    shader.AmbientFactor:=0.4;    shader.SpecularFactor:=0.5;    shader.LightSourceDistanceTerm := 400;    shader.LightColor:=BGRA(255,255,255,255);    bigRender := TBGRATextEffectFontRenderer.Create(shader, true);    bigFont  := TBGLRenderedFont.Create(bigRender, true);    bigFont.Name := 'fairlight';    bigFont.EmHeight := 44;    //bigFont.Style:=[fsBold];    GLBigFont := bigFont; end; procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;  BGLContext: TBGLContext; ElapsedMs: integer);begin          // Module play     SetMasterVolume(master_vol);     if( master_vol<1.0) then master_vol := master_vol + 0.1;      Upda]"]>BlockedsicStream(music); end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);begin      // le traitement du sampler2D comme texture  // roto_zoom_shader.Image0 := 0;     //roto_zoom_shader.Intensity:= 1.0;     gl_surface := roto_zoom_shader.Render(texture0);   // container de l'image0 affichee par le shader     BGLContext.Canvas.PutImage(0,0,texture0,255);     BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);     BGLContext.Canvas.PutImage(0,558,barreBas,255);     bigFont.TextOut(0 ,550,message[message_index],BGRA(225,0,0,alfa));  end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin      // libere les textures et le shader !!  texture0    := nil;  gl_surface := nil;  GLBigFont := nil;  barreHaut:= nil;  barreBas := nil;  FreeAndNil(roto_zoom_shader); end; procedure TForm1.FormDestroy(Sender: TObject);begin // De- Initialization UnloadMusicStream(music);  // Unload music stream buffers from RAM CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)end;  end.  Rotozoom Shader Unit quite simple : Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception unit BGRARotozoom; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type   TBGLRotozoom = class(TBGLShader3D)   private  function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    // time    FTime: TUniformVariableSingle;    FTimer : Single;     FImage0: TUniformVariableInteger;    FImage0V : Integer;     FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;     // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;     property Image0: integer read FImage0V write FImage0V;   property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;   end; implementation function TBGLRotozoom.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLRotozoom.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLBilateralFilter } constructor TBGLRotozoom.Create(ACanvas: TBGLCustomCanvas); begin// vertexinherited Create(ACanvas,'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +'  gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +'}', // fragment shader'//out vec4 FragmentColor;'#10 +'uniform float time;'#10+'uniform sampler2D tex;'#10+  'void main()'#10 +'{'#10 +'vec2 uv =  texCoord.xy -0.5    ;                            '#10+// flip y'  uv.y = 1.0-uv.y;                                           '#10+// resolution down 'uv = floor(256.0*uv)/256.0;'#10+// texture xy_position//'    vec2  xy_pos = vec2(0.09,0.25);'#10+ '    uv *= 10.0;                                                    '#10+'    uv *= sin(2.0*time);                                              '#10+'  uv *= mat2(cos(time),-sin(time),sin(time),cos(time));         '#10+'    // Output to screen                                           '#10+'    gl_FragColor = texture2D(tex,vec2(uv.x/2.5,uv.y/2.5));      '#10+ //' gl_FragColor = vec4(1.0,0.4,0.0, 1.0);                      '#10+   '}','varying vec2 texCoord;', '130');   FTime := UniformSingle['time'];      // float uniform  FImage0    := UniformInteger['tex'];  FCanvasSize := UniformPointF['canvasSize'];   FImage0V   := 0;  FTimer := 0.0; end;  procedure TBGLRotozoom.StartUse;begin  inherited StartUse;   FTime.Update;   FTime.Value:=FTimer;   FImage0.Update;   FImage0.Value:=FImage0V;   end; function TBGLRotozoom.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin   previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf; // in case comment the two next line, if you not want to see black rectangle !!  //-----------------------------------------------------------------  //   Canvas.Fill(BGRAPixelTransparent);  //   Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);  //-----------------------------------------------------------------  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;   ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;  end;  end. ---------------------------------------------------------------------- Gigatron · 2024-08-29 12:59 Hi, So this is the last shader of this month, this time it use FBM (Fractional Brownian Motion) for generating steam or smoke effect with texture . YT : https://www.youtube.com/watch?v=RhVz6zpHzVE Regards Gtr The main unit : Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  StdCtrls, BGRABitmap, BGRABitmapTypes,   BGLVirtualScreen,  BGRAOpenGL, BGRAText,BGRATextFX,BGRASteam,  BGRAGradients,BGRAFontGL, raylib  ; // raylib unit;  type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;    ElapsedMs: integer);    procedure BGLVirtualScreen1LoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormDestroy(Sender: TObject);     procedure Timer1Timer(Sender: TObject);    procedure FormCreate(Sender: TObject);    private    steam_shader: TBGLSteam;    GLBigFont: IBGLFont;    bigFont: TBGLRenderedFont;    public    texture0,gl_surface,barreBas,gtr : IBGLTexture;   end; var  Form1: TForm1;  music:TMusic;  master_vol : single;  message_index,alfa_time : integer;  s_sin : single;  alfa_id : integer;  f_intensity : single;  alfa : Array[0..60] of Byte =(0,10,20,30,40,50,60,70,80,90,100,110,120,130,140,150,160,170,                              180,190,200,210,220,230,240,250,255,255,255,255,255,255,255,255,                              255,250,240,230,220,210,200,190,180,170,160,150,140,130,120,110,                              100,90,80,70,60,50,40,30,20,10,0);   message : Array[0..23] Of String =('   GIGATRON PRESENTS    ',                                   '  BGRA GL STEAM SHADER  ',                                   'SFX : CHROMAG/TALENT HJB',                                   '   PROTRACKER MODULE    ',                                     '   DEMO PROGRAMMED BY   ',                                     ' GIGATRON ON 24/08/2024 ',                                     ' GREETINGS LIST IN ORDER',                                     '   CIRCULAR FOR BGRA    ',                                     '    GUVACODE RAYLAZ     ',                                     '   RAYSAN FOR RAYLIB    ',                                     'ETOWNER, STATIC Z, DSR3 ',                                     '  LILLY, TRONIC DESIGN  ',                                     '  PARALLAX, SUB-SERO    ',                                   '  THE LAZARUS FPC STAFF ',                                   '    SUB QUANTUM TECH    ',                                   '  BLIZZARD RAZOR-1911   ',                                   '   SUB-SERO TBL BRONX   ',                                   '   ANTI BYTE OFFA SIM   ',                                     '   PHENOMENA NORT-STAR  ',                                     '   COMPLEX  RED-SECTOR  ',                                     '    STAR- COM DEFJAM     ',                                     'AMIGA THE BEST COMPUTER ',                                     '    AND ALL THE REST  ',                                     '   WE ARE NOT ALONE !!! ');  pos_y,logo_x : integer;  implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  alfa_id :=0; message_index :=0; alfa_time :=0; s_sin := 0; pos_y :=0; f_intensity :=0.0;   // Initialization audio + load module  InitAudioDevice();  music := LoadMusicStream(PChar(GetApplicationDirectory + 'chromag- shock_therapy23.xm')); //   module  master_vol := 0.0;  music.looping := true;  PlayMusicStream(music); end;  procedure TForm1.Timer1Timer(Sender: TObject);begin    steam_shader.Time:= steam_shader.Time +0.008;    steam_shader.Intensity:=f_intensity;    s_sin := s_sin +0.06;    inc(alfa_time);     if (pos_y >=60) then    begin    if (alfa_time>5) then    begin     alfa_id :=alfa_id +1;     if(alfa_id>=High(alfa)) then     begin          inc(message_index);        alfa_id := 0;         if message_index >=24 then message_index :=0;     end;          alfa_time :=0;          if(f_intensity<1.4) then  f_intensity := f_intensity +0.004;     end;     end;    if (pos_y < 60) then pos_y := pos_y + 2 ;    if (logo_x>-2460) then  logo_x := logo_x - 2 ;   BGLVirtualScreen1.Invalidate; end;   procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;  BGLContext: TBGLContext);  var bigRender: TBGRATextEffectFontRenderer;    shader : TPhongShading; begin   texture0  := BGLTexture(ResourceFile('girl512-8.jpg'));  // texture must power of TWO size !!   gtr       := BGLTexture(ResourceFile('gtr2.png'));   gl_surface:= BGLTexture(ResourceFile('gl_surface.jpg'));     steam_shader := TBGLSteam.Create(BGLContext.Canvas );    // barre    barreBas     := BGLTexture(ResourceFile('barre_bas.png'));    // font    shader := TPhongShading.Create;    shader.LightPosition := Point(0, 200);    shader.LightPositionZ:=10;    shader.AmbientFactor:=0.4;    shader.SpecularFactor:=0.5;    shader.LightSourceDistanceTerm := 400;    shader.LightColor:=BGRA(255,255,255,255);    bigRender := TBGRATextEffectFontRenderer.Create(shader, true);    bigFont  := TBGLRenderedFont.Create(bigRender, true);    bigFont.Name := 'Affirmative';    bigFont.EmHeight := 54;    //bigFont.Style:=[fsBold];    GLBigFont := bigFont; end; procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;  BGLContext: TBGLContext; ElapsedMs: integer);begin          // Module play     SetMasterVolume(master_vol);     if( master_vol<1.0) then master_vol := master_vol + 0.1;     Upda]"]>BlockedsicStream(music); end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);begin      gl_surface := steam_shader.Render(texture0); // container texture0 no need to draw else;     BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);     BGLContext.Canvas.PutImage(0,608-pos_y,barreBas,255);     bigFont.TextOut(20+64*sin(s_sin),494+40,message[message_index], BGRA(0,100,255,alfa[alfa_id]));      BGLContext.Canvas.PutImage(800+logo_x,100, gtr);end; procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  // libere les textures et le shader et le Font gl !!  texture0    := nil;  gtr         := nil;  gl_surface  := nil;  GLBigFont   := nil;  barreBas    := nil;  FreeAndNil(steam_shader); end; procedure TForm1.FormDestroy(Sender: TObject);begin // De-Initialization UnloadMusicStream(music);  // Unload music stream buffers from RAM CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)end;  end.  Shader Unit ; Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // SPDX- License-Identifier: LGPL-3.0-linking-exception unit BGRASteam; {$mode objfpc}{$H+} interface uses  BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType; type   TBGLSteam = class(TBGLShader3D)   private  function GetCanvasSize: TPointF;  procedure SetCanvasSize(AValue: TPointF);   protected    // time    FTime: TUniformVariableSingle;    FTimer : Single;    // intensity    FIntensity  : TUniformVariableSingle;    FIntensityV : Single;     FImage0: TUniformVariableInteger;    FImage0V : Integer;     FCanvasSize: TUniformVariablePointF;    procedure StartUse; override;   public     constructor Create(ACanvas: TBGLCustomCanvas);    function Render(ATexture: IBGLTexture): IBGLTexture; overload;     // propriete  ecriture des uniforms    property Time: Single read FTimer write FTimer;    property Intensity: Single read FIntensityV write FIntensityV;     property Image0: integer read FImage0V write FImage0V;     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;   end; implementation function TBGLSteam.GetCanvasSize: TPointF;begin  result := FCanvasSize.Value;end; procedure TBGLSteam.SetCanvasSize(AValue: TPointF);begin  FCanvasSize.Value := AValue;end;  { TBGLSteam } constructor TBGLSteam.Create(ACanvas: TBGLCustomCanvas); begininherited Create(ACanvas,// vertex'uniform vec2 canvasSize;'#10 +'void main(void) {'#10 +'  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +'  gl_FrontColor = gl_Color;'#10 +' //texCoord = gl_Vertex.xy / canvasSize;'#10 +' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +'}', // fragment shader'uniform float time;'#10+'uniform sampler2D tex;'#10+'uniform float intensity;'#10+ 'float random(vec2 pos) {                                                        '#10+'       return fract(1.0 * sin(pos.y + fract(80.0 * sin(pos.x))));                     '#10+'}                                                                             '#10+'                                                                                '#10+'float noise(vec2 pos) {                                                         '#10+'       vec2 i = floor(pos);                                                           '#10+'       vec2 f = fract(pos);                                                         '#10+'       float a = random(i + vec2(0.0, 0.0));                                          '#10+'       float b = random(i + vec2(1.0, 0.0));                                          '#10+'       float c = random(i + vec2(0.0, 1.0));                                        '#10+'       float d = random(i + vec2(1.0, 1.0));                                          '#10+'       vec2 u = f * f * (3.0 - 2.0 * f);                                              '#10+'       return mix(a, b, u.x) + (c - a) * u.y * (1.0 - u.x) + (d - b) * u.x * u.y;     '#10+'}                                                                                   '#10+ 'float fbm(vec2 pos) {                                                                 '#10+'       float v = 0.0;                                                               '#10+'       float a = 0.5;                                                               '#10+'       vec2 shift = vec2(100.0);                                                      '#10+'       mat2 rot = mat2(cos(0.15), sin(0.15), -sin(0.25), cos(0.5));                   '#10+'       for (int i=0; i < 12; i++) {                                                   '#10+'             v += a * noise(pos);                                                 '#10+'               pos = rot * pos * 2. + shift;                                        '#10+'               a *= 0.55;                                                           '#10+'       }                                                                            '#10+'     return v;                                                                    '#10+'}                                                                                   '#10+ 'void main()'#10 +'{'#10 +'vec2 uv =  texCoord.xy     ;                                          '#10+// flip y'  uv.y = 1.0-uv.y;                                                    '#10+// resolution down 'uv = floor(512.0*uv)/512.0;'#10+// texture xy_position//'vec2  xy_pos = vec2(0.09,0.25);'#10+ '  float f = fbm(uv * 30.0 * vec2(fbm(uv - (time / 10.0)), fbm(uv * 1.0 + (time / 20.0))));'#10+'  vec3 c = f*texture2D(tex, uv-vec2(-0.028*f,0.014*f)).xyz;                             '#10+'  gl_FragColor = vec4(c, 1.0)*intensity;                                                '#10+ //' gl_FragColor = vec4(1.0,0.4,0.0, 1.0);                        '#10+ // debug  '}','varying vec2 texCoord;', '130');   FTime      := UniformSingle['time'];      // float uniform  FIntensity := UniformSingle['intensity'];  FImage0    := UniformInteger['tex'];  FCanvasSize := UniformPointF['canvasSize'];   FImage0V   := 0;  FTimer := 0.0;  FIntensityV := 0.0;end;  procedure TBGLSteam.StartUse;begin  inherited StartUse;   FTime.Update;   FTime.Value:=FTimer;   FIntensity.Update;   FIntensity.Value:=FIntensityV;   FImage0.Update;   FImage0.Value:=FImage0V;   end; function TBGLSteam.Render(ATexture: IBGLTexture): IBGLTexture;var previousBuf,buf: TBGLCustomFrameBuffer;  previousShader: TBGLCustomShader;begin   previousBuf := Canvas.ActiveFrameBuffer;  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);  Canvas.ActiveFrameBuffer := buf; // in case comment the two next line, if you not want to see black rectangle !!  //-----------------------------------------------------------------  //   Canvas.Fill(BGRAPixelTransparent);  //   Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);  //-----------------------------------------------------------------  previousShader := Canvas.Lighting.ActiveShader;  Canvas.Lighting.ActiveShader := self;   ATexture.Draw(0, 0);  Canvas.Lighting.ActiveShader := previousShader;  Canvas.ActiveFrameBuffer := previousBuf;  result := buf.MakeTextureAndFree;  end;  end.