BGRA Shader Sphere Map
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2025-04-13 20:05

Hi,

Here are another cool fx called Sphere Map from IQ(Shadertoy)
Primitives;
https://www.shadertoy.com/view/llyGDK

Earth Mapped Image From WWW 512x512.
You can load your image and rotate zoom with 60fps.

Have Fun
Near 130 lines of 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 unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Spin, BGRAOpenGL,
BGRABitmapTypes, BGRAOpenGL3D, BGLVirtualScreen; type  { TForm1 }  
TForm1 = class(TForm)    x_rot: TFloatSpinEdit;    ShaderScreen1:
TBGLVirtualScreen;    FragMemo: TMemo;    Timer1: TTimer;   
VertexMemo: TMemo;    y_rot: TFloatSpinEdit;    z_rot:
TFloatSpinEdit;    zoom: TFloatSpinEdit;     procedure
ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext); 
 procedure ShaderScreen1Redraw(Sender: TObject; BGLContext:
TBGLContext);    procedure ShaderScreen1UnloadTextures(Sender:
TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender:
TObject);    procedure Timer1Timer(Sender: TObject);    procedure
InitShader;  // init and start shader   private   public     
 gl_surface : IBGLTexture; shader3 : TBGLShader3D;       ctx  :
TBGLContext;       fshader : string ; vshader : string; // fragment
and vertex  end; var   Form1: TForm1;   tt :
Single; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin  fshader := FragMemo.text; 
vshader := VertexMemo.Text;end; procedure
TForm1.ShaderScreen1Redraw(Sender: TObject; BGLContext:
TBGLContext);begin   if gl_surface <> nil then   
 BGLContext.Canvas.StretchPutImage(0, 0, ShaderScreen1.Width,
ShaderScreen1.Height, gl_surface);   if shader3 <> nil then  begin   
BGLContext.Canvas.Lighting.ActiveShader := shader3; 
end;end; procedure TForm1.ShaderScreen1LoadTextures(Sender: TObject;
BGLContext: TBGLContext);begin   try     gl_surface :=
BGLTexture(ResourceFile('gl.png')); // your image 128*128 or 256*256,
or 512*512    // Create shader    shader3 := TBGLShader3D.Create(    
BGLContext.Canvas,      vshader,   // Vertex shader      fshader,   //
Fragment shader      'varying vec2 texCoord;',      '130');    //
Version GLSL       ctx := BGLContext;       initShader;   // *****
Start Shader  except    on E: Exception do      raise
exception.Create('Shader Error : ' + E.Message);  end;end; procedure
Tform1.InitShader;begin  try    fshader := FragMemo.Text;    vshader
:= VertexMemo.Text;     if Assigned(shader3) then    begin     
ctx.Canvas.Lighting.ActiveShader := nil;      FreeAndNil(shader3);   
end;     shader3 := TBGLShader3D.Create(ctx.Canvas, vshader, fshader,
'varying vec2 texCoord;', '130');    // if shader error,  exception
raised by BGRAOpenGLD3 nice :);     Timer1.Enabled := True; // timer1 
except    on E: Exception do      ShowMessage('Shader Error : ' +
E.Message);  end;end; procedure
TForm1.ShaderScreen1UnloadTextures(Sender: TObject;  BGLContext:
TBGLContext);begin  gl_surface  := nil;  FreeAndNil(shader3); 
BGLContext.Canvas.Lighting.ActiveShader := nil;end; procedure
TForm1.Timer1Timer(Sender: TObject);begin  if shader3 <> nil then 
begin    shader3.UniformPointF['resolution'].Value :=
Pointf(Round(ShaderScreen1.Width),Round(ShaderScreen1.Height));   
shader3.UniformSingle['x_rot'].Value := x_rot.Value;   
shader3.UniformSingle['y_rot'].Value := y_rot.Value;   
shader3.UniformSingle['z_rot'].Value := z_rot.Value;   
shader3.UniformSingle['zoom'].Value := zoom.Value;   
shader3.UniformSingle['tm'].Value := tt;    tt := tt + 0.02;   
ShaderScreen1.Invalidate;  end;end; end.

----------------------------------------------------------------------
Lulu · 2025-04-14 18:05

very nice

----------------------------------------------------------------------
Gigatron · 2025-04-14 20:37

Quote from: Lulu on April 14, 2025, 08:05:06 pmvery nice 

Thank you,

After that we can select primitives, like sphere , box, cylinder,
sdbox ect.. finally you can add a million of
fx to the pixel 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 unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Spin, BGRAOpenGL,
BGRABitmapTypes, BGRAOpenGL3D, BGLVirtualScreen; type  { TForm1 }  
TForm1 = class(TForm)    x_rot: TFloatSpinEdit;    ShaderScreen1:
TBGLVirtualScreen;    FragMemo: TMemo;    Timer1: TTimer;   
VertexMemo: TMemo;    y_rot: TFloatSpinEdit;    shape_num:
TFloatSpinEdit;    z_rot: TFloatSpinEdit;    zoom: TFloatSpinEdit;   
br: TFloatSpinEdit;     procedure ShaderScreen1LoadTextures(Sender:
TObject; BGLContext: TBGLContext);    procedure
ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);   
procedure ShaderScreen1UnloadTextures(Sender: TObject; BGLContext:
TBGLContext);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);    procedure InitShader;  // init and
start shader   private   public       gl_surface : IBGLTexture;
shader3 : TBGLShader3D;       ctx  : TBGLContext;       fshader :
string ; vshader : string; // fragment and vertex  end; var   Form1:
TForm1;   tt : Single; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin  fshader := FragMemo.text; 
vshader := VertexMemo.Text;end; procedure
TForm1.ShaderScreen1Redraw(Sender: TObject; BGLContext:
TBGLContext);begin   if gl_surface <> nil then   
 BGLContext.Canvas.StretchPutImage(0, 0, ShaderScreen1.Width,
ShaderScreen1.Height, gl_surface);   if shader3 <> nil then  begin   
BGLContext.Canvas.Lighting.ActiveShader := shader3; 
end;end; procedure TForm1.ShaderScreen1LoadTextures(Sender: TObject;
BGLContext: TBGLContext);begin   try     gl_surface :=
BGLTexture(ResourceFile('gl.png')); // your image 128*128 or 256*256,
or 512*512    // Create shader    shader3 := TBGLShader3D.Create(    
BGLContext.Canvas,      vshader,   // Vertex shader      fshader,   //
Fragment shader      'varying vec2 texCoord;',      '130');    //
Version GLSL       ctx := BGLContext;       initShader;   // *****
Start Shader  except    on E: Exception do      raise
exception.Create('Shader Error : ' + E.Message);  end;end; procedure
Tform1.InitShader;begin  try    fshader := FragMemo.Text;    vshader
:= VertexMemo.Text;     if Assigned(shader3) then    begin     
ctx.Canvas.Lighting.ActiveShader := nil;      FreeAndNil(shader3);   
end;     shader3 := TBGLShader3D.Create(ctx.Canvas, vshader, fshader,
'varying vec2 texCoord;', '130');    // if shader error,  exception
raised by BGRAOpenGLD3 nice :);     Timer1.Enabled := True; // timer1 
except    on E: Exception do      ShowMessage('Shader Error : ' +
E.Message);  end;end; procedure
TForm1.ShaderScreen1UnloadTextures(Sender: TObject;  BGLContext:
TBGLContext);begin  gl_surface  := nil;  FreeAndNil(shader3); 
BGLContext.Canvas.Lighting.ActiveShader := nil;end; procedure
TForm1.Timer1Timer(Sender: TObject);begin  if shader3 <> nil then 
begin    shader3.UniformPointF['resolution'].Value :=
Pointf(Round(ShaderScreen1.Width),Round(ShaderScreen1.Height));   
shader3.UniformSingle['x_rot'].Value := x_rot.Value;   
shader3.UniformSingle['y_rot'].Value := y_rot.Value;   
shader3.UniformSingle['z_rot'].Value := z_rot.Value;   
shader3.UniformSingle['zoom'].Value  := zoom.Value;   
shader3.UniformSingle['br'].Value    := br.Value;    
shader3.UniformSingle['sn'].Value    := shape_num.Value;    
shader3.UniformSingle['tm'].Value    := tt;    tt := tt + 0.02;   
ShaderScreen1.Invalidate;  end;end; end.

----------------------------------------------------------------------
Fred vS · 2025-04-14 21:28

WoaW !

----------------------------------------------------------------------
d2010 · 2025-04-16 08:06

Quote from: Lulu on April 14, 2025, 08:05:06 pmvery nice 
The quality of Lazarus-images  have to low/ few pixels
Everyone, have "LazarusImages" with more resolution 1024x1280,
or 800x600 ?.

----------------------------------------------------------------------
d2010 · 2025-04-21 16:27

Doamne ajuta, 3Dpshere,