BGRA Shader Sphere Map

[Gigatron]

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][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   Spin, BGRAOpenGL, BGRABitmapTypes, BGRAOpenGL3D, BGLVirtualScreen;
10.  
11. type
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     x_rot: TFloatSpinEdit;
16.     ShaderScreen1: TBGLVirtualScreen;
17.     FragMemo: TMemo;
18.     Timer1: TTimer;
19.     VertexMemo: TMemo;
20.     y_rot: TFloatSpinEdit;
21.     z_rot: TFloatSpinEdit;
22.     zoom: TFloatSpinEdit;
23.  
24.     procedure ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
25.     procedure ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
26.     procedure ShaderScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);
27.     procedure FormCreate(Sender: TObject);
28.     procedure Timer1Timer(Sender: TObject);
29.     procedure InitShader;  // init and start shader
30.  
31.   private
32.  
33.   public
34.        gl_surface : IBGLTexture; shader3 : TBGLShader3D;
35.        ctx  : TBGLContext;
36.        fshader : string ; vshader : string; // fragment and vertex
37.   end;
38.  
39. var
40.    Form1: TForm1;
41.    tt : Single;
42.  
43. implementation
44.  
45. {$R *.lfm}
46.  
47. { TForm1 }
48.  
49. procedure TForm1.FormCreate(Sender: TObject);
50. begin
51.   fshader := FragMemo.text;
52.   vshader := VertexMemo.Text;
53. end;
54.  
55. procedure TForm1.ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
56. begin
57.  
58.   if gl_surface <> nil then
59.      BGLContext.Canvas.StretchPutImage(0, 0, ShaderScreen1.Width, ShaderScreen1.Height, gl_surface);
60.  
61.   if shader3 <> nil then
62.   begin
63.     BGLContext.Canvas.Lighting.ActiveShader := shader3;
64.   end;
65. end;
66.  
67. procedure TForm1.ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
68. begin
69.    try
70.      gl_surface := BGLTexture(ResourceFile('gl.png')); // your image 128*128 or 256*256, or 512*512
71.     // Create shader
72.     shader3 := TBGLShader3D.Create(
73.       BGLContext.Canvas,
74.       vshader,   // Vertex shader
75.       fshader,   // Fragment shader
76.       'varying vec2 texCoord;',
77.       '130');    // Version GLSL
78.        ctx := BGLContext;
79.        initShader;   // ***** Start Shader
80.   except
81.     on E: Exception do
82.       raise exception.Create('Shader Error : ' + E.Message);
83.   end;
84. end;
85.  
86. procedure Tform1.InitShader;
87. begin
88.   try
89.     fshader := FragMemo.Text;
90.     vshader := VertexMemo.Text;
91.  
92.     if Assigned(shader3) then
93.     begin
94.       ctx.Canvas.Lighting.ActiveShader := nil;
95.       FreeAndNil(shader3);
96.     end;
97.  
98.     shader3 := TBGLShader3D.Create(ctx.Canvas, vshader, fshader, 'varying vec2 texCoord;', '130');
99.     // if shader error,  exception raised by BGRAOpenGLD3 nice :);
100.  
101.     Timer1.Enabled := True; // timer1
102.   except
103.     on E: Exception do
104.       ShowMessage('Shader Error : ' + E.Message);
105.   end;
106. end;
107.  
108. procedure TForm1.ShaderScreen1UnloadTextures(Sender: TObject;
109.   BGLContext: TBGLContext);
110. begin
111.   gl_surface  := nil;
112.   FreeAndNil(shader3);
113.   BGLContext.Canvas.Lighting.ActiveShader := nil;
114. end;
115.  
116. procedure TForm1.Timer1Timer(Sender: TObject);
117. begin
118.   if shader3 <> nil then
119.   begin
120.     shader3.UniformPointF['resolution'].Value := Pointf(Round(ShaderScreen1.Width),Round(ShaderScreen1.Height));
121.     shader3.UniformSingle['x_rot'].Value := x_rot.Value;
122.     shader3.UniformSingle['y_rot'].Value := y_rot.Value;
123.     shader3.UniformSingle['z_rot'].Value := z_rot.Value;
124.     shader3.UniformSingle['zoom'].Value := zoom.Value;
125.     shader3.UniformSingle['tm'].Value := tt;
126.     tt := tt + 0.02;
127.     ShaderScreen1.Invalidate;
128.   end;
129. end;
130.  
131. end.

[Lulu]

very nice 

[Gigatron]

very 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][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   Spin, BGRAOpenGL, BGRABitmapTypes, BGRAOpenGL3D, BGLVirtualScreen;
10.  
11. type
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     x_rot: TFloatSpinEdit;
16.     ShaderScreen1: TBGLVirtualScreen;
17.     FragMemo: TMemo;
18.     Timer1: TTimer;
19.     VertexMemo: TMemo;
20.     y_rot: TFloatSpinEdit;
21.     shape_num: TFloatSpinEdit;
22.     z_rot: TFloatSpinEdit;
23.     zoom: TFloatSpinEdit;
24.     br: TFloatSpinEdit;
25.  
26.     procedure ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
27.     procedure ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
28.     procedure ShaderScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);
29.     procedure FormCreate(Sender: TObject);
30.     procedure Timer1Timer(Sender: TObject);
31.     procedure InitShader;  // init and start shader
32.  
33.   private
34.  
35.   public
36.        gl_surface : IBGLTexture; shader3 : TBGLShader3D;
37.        ctx  : TBGLContext;
38.        fshader : string ; vshader : string; // fragment and vertex
39.   end;
40.  
41. var
42.    Form1: TForm1;
43.    tt : Single;
44.  
45. implementation
46.  
47. {$R *.lfm}
48.  
49. { TForm1 }
50.  
51. procedure TForm1.FormCreate(Sender: TObject);
52. begin
53.   fshader := FragMemo.text;
54.   vshader := VertexMemo.Text;
55. end;
56.  
57. procedure TForm1.ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
58. begin
59.  
60.   if gl_surface <> nil then
61.      BGLContext.Canvas.StretchPutImage(0, 0, ShaderScreen1.Width, ShaderScreen1.Height, gl_surface);
62.  
63.   if shader3 <> nil then
64.   begin
65.     BGLContext.Canvas.Lighting.ActiveShader := shader3;
66.   end;
67. end;
68.  
69. procedure TForm1.ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
70. begin
71.    try
72.      gl_surface := BGLTexture(ResourceFile('gl.png')); // your image 128*128 or 256*256, or 512*512
73.     // Create shader
74.     shader3 := TBGLShader3D.Create(
75.       BGLContext.Canvas,
76.       vshader,   // Vertex shader
77.       fshader,   // Fragment shader
78.       'varying vec2 texCoord;',
79.       '130');    // Version GLSL
80.        ctx := BGLContext;
81.        initShader;   // ***** Start Shader
82.   except
83.     on E: Exception do
84.       raise exception.Create('Shader Error : ' + E.Message);
85.   end;
86. end;
87.  
88. procedure Tform1.InitShader;
89. begin
90.   try
91.     fshader := FragMemo.Text;
92.     vshader := VertexMemo.Text;
93.  
94.     if Assigned(shader3) then
95.     begin
96.       ctx.Canvas.Lighting.ActiveShader := nil;
97.       FreeAndNil(shader3);
98.     end;
99.  
100.     shader3 := TBGLShader3D.Create(ctx.Canvas, vshader, fshader, 'varying vec2 texCoord;', '130');
101.     // if shader error,  exception raised by BGRAOpenGLD3 nice :);
102.  
103.     Timer1.Enabled := True; // timer1
104.   except
105.     on E: Exception do
106.       ShowMessage('Shader Error : ' + E.Message);
107.   end;
108. end;
109.  
110. procedure TForm1.ShaderScreen1UnloadTextures(Sender: TObject;
111.   BGLContext: TBGLContext);
112. begin
113.   gl_surface  := nil;
114.   FreeAndNil(shader3);
115.   BGLContext.Canvas.Lighting.ActiveShader := nil;
116. end;
117.  
118. procedure TForm1.Timer1Timer(Sender: TObject);
119. begin
120.   if shader3 <> nil then
121.   begin
122.     shader3.UniformPointF['resolution'].Value := Pointf(Round(ShaderScreen1.Width),Round(ShaderScreen1.Height));
123.     shader3.UniformSingle['x_rot'].Value := x_rot.Value;
124.     shader3.UniformSingle['y_rot'].Value := y_rot.Value;
125.     shader3.UniformSingle['z_rot'].Value := z_rot.Value;
126.     shader3.UniformSingle['zoom'].Value  := zoom.Value;
127.     shader3.UniformSingle['br'].Value    := br.Value;
128.  
129.     shader3.UniformSingle['sn'].Value    := shape_num.Value;
130.  
131.     shader3.UniformSingle['tm'].Value    := tt;
132.     tt := tt + 0.02;
133.     ShaderScreen1.Invalidate;
134.   end;
135. end;
136.  
137. end.

[Fred vS]

WoaW ! 

[d2010]

very nice 

The quality of Lazarus-images  have to low/ few pixels
Everyone, have "LazarusImages" with more resolution 1024x1280,
or 800x600 ?.

[d2010]

Doamne ajuta, 3Dpshere,