### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Recent

#### Gigatron

• Full Member
• Posts: 133
• Amiga Rulez !!
##### Re: Demo Scene BGRA GL Shader
« Reply #45 on: August 16, 2024, 01:22:08 am »
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][+][-]
1. // PICO-8
2. '    if(c_mode==3.0){           '#10+
3. 'TRY_COLOR (vec3(0,0,0       ));'#10+
4. 'TRY_COLOR (vec3(29,43,83    ));'#10+
5. 'TRY_COLOR (vec3(126,37,83   ));'#10+
6. 'TRY_COLOR (vec3(0,135,81    ));'#10+
7. 'TRY_COLOR (vec3(171,82,54   ));'#10+
8. 'TRY_COLOR (vec3(95,87,79    ));'#10+
9. 'TRY_COLOR (vec3(194,195,199 ));'#10+
10. 'TRY_COLOR (vec3(255,241,232 ));'#10+
11. 'TRY_COLOR (vec3(255,0,77    ));'#10+
12. 'TRY_COLOR (vec3(255,163,0   ));'#10+
13. 'TRY_COLOR (vec3(255,236,39  ));'#10+
14. 'TRY_COLOR (vec3(0,228,54    ));'#10+
15. 'TRY_COLOR (vec3(41,173,255  ));'#10+
16. 'TRY_COLOR (vec3(131,118,156 ));'#10+
17. 'TRY_COLOR (vec3(255,119,168 ));'#10+
18. 'TRY_COLOR (vec3(255,204,170 ));'#10+
19. '    }
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

#### Gigatron

• Full Member
• Posts: 133
• Amiga Rulez !!
##### Re: Demo Scene BGRA GL Shader
« Reply #46 on: August 16, 2024, 02:41:05 am »
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][+][-]
1. unit Unit1;
2.
3. {\$mode objfpc}{\$H+}
4.
5. interface
6.
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
9.   StdCtrls, BGRABitmap, BGRABitmapTypes, BGRABilateralFilter, BGLVirtualScreen,
10.   BGRAOpenGL, BGRAText,BGRATextFX,
11.   BGRAGradients,BGRAFontGL, RayLib ; // raylib unit;
12.
13. type
14.
15.   { TForm1 }
16.
17.   TForm1 = class(TForm)
18.       BGLVirtualScreen1: TBGLVirtualScreen;
19.       Button1: TButton;
20.       Button2: TButton;
21.       Button3: TButton;
22.       Button4: TButton;
23.       FloatSpinEdit1: TFloatSpinEdit;
24.       OpenDialog1: TOpenDialog;
25.     Timer1: TTimer;
26.     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;
27.       ElapsedMs: integer);
29.       BGLContext: TBGLContext);
30.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
32.       BGLContext: TBGLContext);
33.     procedure Button1Click(Sender: TObject);
34.     procedure Button2Click(Sender: TObject);
35.     procedure Button3Click(Sender: TObject);
36.     procedure Button4Click(Sender: TObject);
37.     procedure FormCreate(Sender: TObject);
38.     procedure FormPaint(Sender: TObject);
39.     procedure Timer1Timer(Sender: TObject);
40.
42.
43.    private
45.     GLBigFont: IBGLFont;
46.     bigFont: TBGLRenderedFont;
47.
48.    public
49.     texture0,gl_surface : IBGLTexture;
50.     barreHaut,barreBas :IBGLTexture;
51.
52.   end;
53.
54. var
55.   Form1: TForm1;
56.   cmode : integer;
57.
58. implementation
59.
60. {\$R *.lfm}
61.
62. { TForm1 }
63.
64. procedure TForm1.FormCreate(Sender: TObject);
65. begin
66.
67.   cmode := 0;
68.
69. end;
70.
71. procedure TForm1.FormPaint(Sender: TObject);
72. begin
73.
74. end;
75.
76. procedure TForm1.Timer1Timer(Sender: TObject);
77. begin
78.
79.  BGLVirtualScreen1.Invalidate;
80.
81. end;
82.
83. procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;
84.   BGLContext: TBGLContext; ElapsedMs: integer);
85.
86. begin
90. end;
91.
93.   BGLContext: TBGLContext);
94.   var bigRender: TBGRATextEffectFontRenderer;
96.  begin
97.    texture0     := BGLTexture(ResourceFile('girl512-5.png'));  // texture must power of TWO size !!
98.    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
99.
101.    // les barres
102.     barreHaut     := BGLTexture(ResourceFile('barre_haut.png'));
103.     barreBas     := BGLTexture(ResourceFile('barre_bas.png'));
104.     // font
113.     bigFont  := TBGLRenderedFont.Create(bigRender, true);
114.     bigFont.Name := 'Dynamic Recompilation';
115.     bigFont.EmHeight := 24;
116.     //bigFont.Style:=[fsBold];
117.     GLBigFont := bigFont;
118.
119.
120. end;
121.
122. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
123.   BGLContext: TBGLContext);
124. begin
125.
126.      // le traitement du sampler2D comme texture
129.      gl_surface := cmap_shader.Render(texture0);   // container de l'image0 affichee par le shader
130.      BGLContext.Canvas.PutImage(0,0,texture0,BGRA(255,255,255,255));
131.      BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);
132.
133.      BGLContext.Canvas.PutImage(0,558,barreBas,BGRA(255,255,255,255));
134.
135. end;
136.
138.   BGLContext: TBGLContext);
139. begin
140.       // libere les textures et le shader !!
141.   texture0    := nil;
142.   gl_surface := nil;
143.   GLBigFont := nil;
144.   barreHaut:= nil;
145.   barreBas := nil;
147.
148.
150.
151.
152. end;
153.
154. procedure TForm1.Button1Click(Sender: TObject);
155. begin
157. end;
158.
159. procedure TForm1.Button2Click(Sender: TObject);
160. begin
161.
162. end;
163.
164.
165. procedure TForm1.Button3Click(Sender: TObject);
166. begin
167.     cmode := 1;
168. end;
169.
170. procedure TForm1.Button4Click(Sender: TObject);
171. begin
172.       cmode := 0;
173. end;
174.
176.
177. begin
178.         if (OpenDialog1.Execute) then
179.         begin
180.         texture0 := BGLTexture(ResourceFile(OpenDialog1.FileName));
181.
182.         end;
183. end;
184.
185.
186. end.
187.

Code: Pascal  [Select][+][-]
2.
3. unit BGRABilateralFilter;
4.
5. {\$mode objfpc}{\$H+}
6.
7. interface
8.
9. uses
10.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
11.
12. type
13.
15.
16.   private
17.
18.   function GetCanvasSize: TPointF;
19.   procedure SetCanvasSize(AValue: TPointF);
20.
21.   protected
22.     // time
23.     FTime: TUniformVariableSingle;
24.     FTimer : Single;
25.     // intensity
26.     Fintensity  : TUniformVariableSingle;
27.     FintensityV : Single;
28.     // Color mode
29.     FMode  : TUniformVariableSingle;
30.     FModeV : Single;
31.
32.     FImage0: TUniformVariableInteger;
33.     FImage0V : Integer;
34.
35.     FCanvasSize: TUniformVariablePointF;
36.     procedure StartUse; override;
37.
38.   public
39.
40.     constructor Create(ACanvas: TBGLCustomCanvas);
41.     function Render(ATexture: IBGLTexture): IBGLTexture; overload;
42.     procedure RenderOnCanvas;
43.     // propriete  ecriture des uniforms
44.     property Time: Single read FTimer write FTimer;
45.     property Intensity :  Single read FintensityV  write FintensityV;
46.     property Cmode :  Single read FModeV  write FModeV ;
47.
48.
49.     property Image0: integer read FImage0V write FImage0V;
50.
51.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
52.
53.
54.   end;
55.
56. implementation
57.
58. function TBGLBilateralFilter.GetCanvasSize: TPointF;
59. begin
60.   result := FCanvasSize.Value;
61. end;
62.
63. procedure TBGLBilateralFilter.SetCanvasSize(AValue: TPointF);
64. begin
65.   FCanvasSize.Value := AValue;
66. end;
67.
68.
69. { TBGLBilateralFilter }
70.
71. constructor TBGLBilateralFilter.Create(ACanvas: TBGLCustomCanvas);
72.
73. begin
74. // vertex
75. inherited Create(ACanvas,
76. 'uniform vec2 canvasSize;'#10 +
77. 'void main(void) {'#10 +
78. '  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +
79. ' // gl_FrontColor = gl_Color;'#10 +
80. ' //texCoord = gl_Vertex.xy / canvasSize;'#10 +
81. ' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +
82. '}',
83.
85. '//out vec4 FragmentColor;'#10 +
86. 'uniform float time;'#10+
87. 'uniform sampler2D tex;'#10+
88. 'uniform float intensity;                        '#10+
89. 'uniform float c_mode;                           '#10+
90.
91. // mrharicot Bilateral Filter
92. '#define SIGMA 10.0                                             '#10+
93. '#define BSIGMA 0.2                                             '#10+
94. '#define MSIZE 15                                               '#10+
95. '                                                               '#10+
96. 'float normpdf(in float x, in float sigma)                      '#10+
97. '{                                                              '#10+
98. '       return 0.39894*exp(-0.5*x*x/(sigma*sigma))/sigma;       '#10+
99. '}                                                              '#10+
100. '                                                               '#10+
101. 'float normpdf3(in vec3 v, in float sigma)                      '#10+
102. '{                                                              '#10+
103. '       return 0.39894*exp(-0.5*dot(v,v)/(sigma*sigma))/sigma;  '#10+
104. '}                                                              '#10+
105.
106.
107.
108. 'void main()'#10 +
109. '{'#10 +
110. 'vec2 uv =  texCoord.xy   ;            '#10+
111. // flip y
112. //'// uv.y = 1.-uv.y;                                           '#10+
113. // resolution down
114. //'uv = floor(256.0*uv)/256.0;'#10+
115. // texture xy_position
116. //'    vec2  xy_pos = vec2(0.09,0.25);'#10+
117.
118. 'vec3 c = texture2D(tex,gl_FragCoord.xy/512.0).rgb;                       '#10+
119. 'if (c_mode==0.0)                                                                                       '#10+
120. ' {                                                                                                     '#10+
121. '       gl_FragColor = vec4(c, 1.0);                                                                    '#10+
122. '                                                                                                       '#10+
123. ' } else {                                                                                              '#10+
124. '                                                                                                       '#10+
125. '//declare stuff                                                                                        '#10+
126. 'const int kSize = (MSIZE-1)/2;                                                                         '#10+
127. 'float kernel[MSIZE];                                                                                   '#10+
128. 'vec3 final_colour = vec3(0.0);                                                                         '#10+
129. '                                                                                                       '#10+
130. '//create the 1-D kernel                                                                                '#10+
131. 'float Z = 0.0;                                                                                         '#10+
132. 'for (int j = 0; j <= kSize; ++j)                                                                       '#10+
133. '{                                                                                                      '#10+
134. 'kernel[kSize+j] = kernel[kSize-j] = normpdf(float(j), SIGMA);                                          '#10+
135. '}                                                                                                      '#10+
136. '                                                                                                       '#10+
137. '                                                                                                       '#10+
138. '       vec3 cc;                                                                                        '#10+
139. '       float factor;                                                                                   '#10+
140. '       float bZ = 1.0/normpdf(0.0, intensity);                                                            '#10+
141. '       //read out the texels                                                                           '#10+
142. '       for (int i=-kSize; i <= kSize; ++i)                                                             '#10+
143. '       {                                                                                               '#10+
144. '               for (int j=-kSize; j <= kSize; ++j)                                                     '#10+
145. '       {                                                                                               '#10+
146. '       cc = texture2D(tex, (gl_FragCoord.xy+vec2(float(i),float(j)))/512.0 ).rgb;      '#10+
147. '       factor = normpdf3(cc-c, intensity)*bZ*kernel[kSize+j]*kernel[kSize+i];                             '#10+
148. '       Z += factor;                                                                                    '#10+
149. '       final_colour += factor*cc;                                                                      '#10+
150. '                                                                                                       '#10+
151. '               }                                                                                       '#10+
152. '       }                                                                                               '#10+
153. '                                                                                                       '#10+
154. '                                                                                                       '#10+
155. '       gl_FragColor = vec4(final_colour/Z, 1.0);                                                       '#10+
156. '}                                                                                                      '#10+
157.
158.
159. '}',
160. 'varying vec2 texCoord;', '130');
161.
162.   FTime := UniformSingle['time'];      // float uniform
163.   Fintensity := UniformSingle['intensity'];
164.   FMode      := UniformSingle['c_mode'];
165.   FImage0    := UniformInteger['tex'];
166.   FCanvasSize := UniformPointF['canvasSize'];
167.   FImage0V   := 0;
168.   FTimer := 0;
169.   FintensityV := 0.1;
170.   FModeV := 1.0;
171.
172.
173. end;
174.
175.
176. procedure TBGLBilateralFilter.StartUse;
177. begin
178.   inherited StartUse;
179.   FTime.Update;
180.   FTime.Value:=FTimer;
181.   FImage0.Update;
182.   FImage0.Value:=FImage0V;
183.   FIntensity.Update;
184.   Fintensity.Value:= FintensityV;
185.   FMode.Update;
186.   FMode.Value:= FModeV;
187.
188.
189. end;
190.
191. function TBGLBilateralFilter.Render(ATexture: IBGLTexture): IBGLTexture;
192. var previousBuf,buf: TBGLCustomFrameBuffer;
194. begin
195.
196.   previousBuf := Canvas.ActiveFrameBuffer;
197.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
198.   Canvas.ActiveFrameBuffer := buf;
199. // in case comment the two next line, if you not want to see black rectangle !!
200.   //-----------------------------------------------------------------
201.  // Canvas.Fill(BGRAPixelTransparent);
202.
203.  // Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);
204.   //-----------------------------------------------------------------
207.   ATexture.Draw(0, 0);
209.   Canvas.ActiveFrameBuffer := previousBuf;
210.   result := buf.MakeTextureAndFree;
211.
212.   // canvas renderer
213.   //previousBuf := Canvas.ActiveFrameBuffer;
214.   //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
215.   //Canvas.ActiveFrameBuffer := buf;
216.   //Canvas.Fill(BGRAPixelTransparent);
217.   //RenderOnCanvas;
218.   //Canvas.ActiveFrameBuffer := previousBuf;
219.   //result := buf.MakeTextureAndFree;
220.
221. end;
222.
223. procedure TBGLBilateralFilter.RenderOnCanvas;
224. var
226. begin
229.   CanvasSize := PointF(800,600);
230.   Canvas.FillRect(0, 0, 800,600, CSSBlack);
232. end;
233. end.
« Last Edit: August 16, 2024, 06:25:10 pm by Gigatron »
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

#### circular

• Hero Member
• Posts: 4333
##### Re: Demo Scene BGRA GL Shader
« Reply #47 on: August 17, 2024, 10:27:49 pm »
That's a neat filter, making the gradient smooth but not making the image blurry!
Conscience is the debugger of the mind

#### Gigatron

• Full Member
• Posts: 133
• Amiga Rulez !!
##### Re: Demo Scene BGRA GL Shader
« Reply #48 on: August 19, 2024, 06:39:20 pm »
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

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 ?
« Last Edit: August 19, 2024, 11:59:40 pm by Gigatron »
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

#### Gigatron

• Full Member
• Posts: 133
• Amiga Rulez !!
##### Re: Demo Scene BGRA GL Shader
« Reply #49 on: August 20, 2024, 05:59:13 pm »
Hi,
Let's Try to make a nice fx with glsl shader a sort of procedural map;

Finally YT;

The Main Unit  :
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, Spin,
9.   StdCtrls, BGRABitmap, BGRABitmapTypes, BGRABilateralFilter, BGLVirtualScreen,
10.   BGRAOpenGL, BGRAText,BGRATextFX,
11.   BGRAGradients,BGRAFontGL, RayLib , // raylib unit;
12.
13. BGRAOpenGL3D,   BGRACanvasGL, BGRAOpenGLType;
14.
15. type
16.
17.   { TForm1 }
18.
19.   TForm1 = class(TForm)
20.       BGLVirtualScreen1: TBGLVirtualScreen;
21.       Button4: TButton;
22.       OpenDialog1: TOpenDialog;
23.     Timer1: TTimer;
24.     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;
25.       ElapsedMs: integer);
27.       BGLContext: TBGLContext);
28.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
30.       BGLContext: TBGLContext);
31.
32.     procedure FormCreate(Sender: TObject);
33.     procedure FormDestroy(Sender: TObject);
34.     procedure Timer1Timer(Sender: TObject);
35.
36.    private
38.     GLBigFont: IBGLFont;
39.     bigFont: TBGLRenderedFont;
40.
41.    public
42.     texture0,gl_surface,barreBas,copper : IBGLTexture;
43.
44.   end;
45.
46. var
47.   Form1: TForm1;
48.   cmode,tm : integer;
49.   music:TMusic;
50.   master_vol : single;
51.   s_sin  : single;
52.   b_mode : Array[0..26] Of String =('THE PROCEDURAL MAP BGRA',
54.                                     'IN ACTION',
55.                                     '***********************',
56.                                     'DEMO PROGRAMMED BY ',
57.                                     'GIGATRON ON 18/08/2024',
58.                                     '***********************',
59.                                     'WE CAN DO REAL',
60.                                     'INTERESTING DEMO',
61.                                     'AND A MILLION OF ',
62.                                     'DIFFERENT FX WITH THE',
63.                                     'NEW BGRA VERSION',
64.                                     'GREETINGS TO CIRCULAR',
65.                                     'FOR THE BGRA COMPONENT',
66.                                     'GUVACODE RAYLAZ COMPONENT',
67.                                     'MY LOVE     *************',
68.                                     'THE LAZARUS FPC STAFF',
69.                                     'MEMBERS OF SUB QUANTUM TECH',
71.                                     'SUB-SERO TBL BRONX HOTLINE',
72.                                     'ANTI BYTE OFFA SIM MEGAFORCE',
73.                                     'PHENOMENA NORT-STAR TRISTAR',
74.                                     'COMPLEX TRISTAR RED-SECTOR',
75.                                     'WARM STAR SQUAZAR HQC DEFJAM',
76.                                     'XDT FOR THE GREAT MODULE',
77.                                     'AND ALL I FORGOT AROUND',
78.                                     'WE ARE NOT ALONE !!!');
79.
80. implementation
81.
82. {\$R *.lfm}
83.
84. { TForm1 }
85.
86. procedure TForm1.FormCreate(Sender: TObject);
87. begin
88.
89.   cmode := 0;
90.   tm :=0;
91.
92.    // Initialization audio + load module
93.   InitAudioDevice();
94.   music := LoadMusicStream(PChar(GetApplicationDirectory + 'noname.mod'));    // xm module
95.   master_vol := 0;
96.   music.looping := true;
97.   PlayMusicStream(music);
98.
99. end;
100.
101. procedure TForm1.FormDestroy(Sender: TObject);
102. begin
103.    // De-Initialization
105.  CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)
106. end;
107.
108. procedure TForm1.Timer1Timer(Sender: TObject);
109. begin
110.  inc(tm);
111.  s_sin := s_sin +0.04;
112.  if (tm>100) then
113.  begin
114.    cmode := cmode +1;
115.    tm :=0;
116.    if (cmode>=27) then cmode :=0;
117.  end;
118.  BGLVirtualScreen1.Invalidate;
119. end;
120.
121. procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;BGLContext: TBGLContext; ElapsedMs: integer);
122.
123. begin
126.      Button4.Caption := ' ' + b_mode[cmode] + ' ';
127.      Button4.Width:= 28*b_mode[cmode].Length;
128.      Button4.Left := 10;
130.      SetMasterVolume(master_vol);
131.      if( master_vol<1.0) then master_vol := master_vol + 0.01;
132.       UpdateMusicStream(music);
133. end;
134.
135. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
136.   var bigRender: TBGRATextEffectFontRenderer;
138.
139.  begin
140.    texture0     := BGLTexture(ResourceFile('m01.png'));  // texture must power of TWO size 512*512!!
141.    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
142.    copper := BGLTexture(ResourceFile('cop_23.png'));
143.
145.     // les barres
146.     barreBas     := BGLTexture(ResourceFile('barre_bas.png'));
147.     // font
153.
156.     bigFont  := TBGLRenderedFont.Create(bigRender, true);
157.     bigFont.Name := 'fairlight';
158.     bigFont.EmHeight := 48;
159.     bigFont.Color:=BGRA(0,190,255,255);
160.     //bigFont.Style:=[fsBold];
161.     GLBigFont := bigFont;
162.
163. end;
164.
165. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;BGLContext: TBGLContext);
166.
167. begin
168.      BGLContext.Canvas.PutImage(0,520-480*abs(sin(s_sin))*0.8,copper,255);
169.      // le traitement du sampler2D comme texture
173.      gl_surface := cmap_shader.Render(texture0);   // container de l'image0 affichee par le shader
174.      BGLContext.Canvas.StretchPutImage(175,0,460 ,600, gl_surface);
175.      bigFont.TextOut(40,5,'GIGATRON 18/08/2024');
176.      BGLContext.Canvas.PutImage(0,555,barreBas,255);
177.
178. end;
179.
181. begin
182.       // libere les textures et le shader !!
183.   texture0   := nil;
184.   copper     := nil;
185.   gl_surface := nil;
186.   GLBigFont := nil;
187.   barreBas := nil;
189. end;
190.
191.
192. end.
193.

Code: Pascal  [Select][+][-]
2.
3. unit BGRABilateralFilter;
4.
5. {\$mode objfpc}{\$H+}
6.
7. interface
8.
9. uses
10.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
11.
12. type
13.
15.
16.   private
17.
18.   function GetCanvasSize: TPointF;
19.   procedure SetCanvasSize(AValue: TPointF);
20.
21.   protected
22.     // time
23.     FTime: TUniformVariableSingle;
24.     FTimer : Single;
25.     // intensity
26.     Fintensity  : TUniformVariableSingle;
27.     FintensityV : Single;
28.     // Color mode
29.     FMode  : TUniformVariableInteger;
30.     FModeV : Integer;
31.
32.     FImage0: TUniformVariableInteger;
33.     FImage0V : Integer;
34.     FImage1: TUniformVariableInteger;
35.     FImage1V : Integer;
36.
37.
38.     FCanvasSize: TUniformVariablePointF;
39.     procedure StartUse; override;
40.
41.   public
42.
43.     constructor Create(ACanvas: TBGLCustomCanvas);
44.     function Render(ATexture: IBGLTexture): IBGLTexture; overload;
45.
46.     // propriete  ecriture des uniforms
47.     property Time: Single read FTimer write FTimer;
48.     property Intensity :  Single read FintensityV  write FintensityV;
49.     property Cmode :  integer read FModeV  write FModeV ;
50.
51.     property Image0: integer read FImage0V write FImage0V;
52.     property Image1: integer read FImage1V write FImage1V;   // second texture if needed !
53.
54.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
55.
56.
57.   end;
58.
59. implementation
60.
61. function TBGLBilateralFilter.GetCanvasSize: TPointF;
62. begin
63.   result := FCanvasSize.Value;
64. end;
65.
66. procedure TBGLBilateralFilter.SetCanvasSize(AValue: TPointF);
67. begin
68.   FCanvasSize.Value := AValue;
69. end;
70.
71.
72. { TBGLBilateralFilter }
73.
74. constructor TBGLBilateralFilter.Create(ACanvas: TBGLCustomCanvas);
75.
76. begin
77. // vertex
78. inherited Create(ACanvas,
79.
80. 'uniform vec2 canvasSize;'#10 +
81. 'void main(void) {'#10 +
82. '  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +
83. ' // gl_FrontColor = gl_Color;'#10 +
84. ' //texCoord = gl_Vertex.xy / canvasSize;'#10 +
85. ' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +
86. '}',
87.
89. '//out vec4 FragmentColor;'#10 +
90. 'uniform float time;'#10+
91. 'uniform sampler2D tex0;'#10+
92. 'uniform sampler2D tex1;'#10+
93. 'uniform float intensity;                      '#10+
94. 'uniform int c_mode;                           '#10+
95.
96.
97. 'vec3 hsv2rgb(vec3 c){                             '#10+
98. '                                                  '#10+
99. 'vec4 K=vec4(1.0,2.0/3.0,1.0/3.0,3.0);             '#10+
100. 'vec3 p=abs(fract(c.xxx+K.xyz)*6.0-K.www);         '#10+
101. 'return c.z*mix(K.xxx,clamp(p-K.xxx,0.0,1.0),c.y); '#10+
102. '}                                                 '#10+
103.
104. 'float luminance(vec3 col){                        '#10+
105. 'return dot(col,vec3(0.299,0.587,0.114));          '#10+
106. '}                                                 '#10+
107.
108. 'float texelHeight(vec4 rgba){                     '#10+
109. 'return luminance(rgba.rgb);                       '#10+
110. '}                                                 '#10+
111.
112. 'vec3 cross_emu(vec3 x, vec3 y) {             '#10+
113. '   return vec3(                              '#10+
114. '       x[1] * y[2] - y[1] * x[2],            '#10+
115. '       x[2] * y[0] - y[2] * x[0],            '#10+
116. '       x[0] * y[1] - y[0] * x[1]);           '#10+
117. '}                                            '#10+
118.
119.
120.
121. 'void main()'#10+
122. '{'#10 +
123. 'vec2 uv =  texCoord.xy   ;            '#10+
124. // flip y
125. ' uv.y = 1.-uv.y;                      '#10+
126. // resolution down
127. //'uv = floor(256.0*uv)/256.0;           '#10+
128. // texture xy_position
129. //'vec2  xy_pos = vec2(0.5,0.0);'#10+
130. //'uv = floor(256.*uv)/256.0;                                    '#10+
131. //Normalmapstrength
132. 'float normal_strength=7.0;                                                                 '#10+
133.
134. 'float height_multiplier=2.0;                                                               '#10+
135. 'float texel_offset=3.5;                                                                    '#10+
136.
137. 'vec3 offset=vec3(texel_offset/512.0,texel_offset/512.0,0.0);                                           '#10+
138.
139. 'vec3 surfaceColor= texture2D(tex0,uv).rgb;                                                         '#10+
140. 'float height=texelHeight(surfaceColor.rgbb)*height_multiplier;                                   '#10+
141. 'vec3 worldPosition=vec3(uv,height);                                                              '#10+
142.
143. 'float ddX= texelHeight(texture2D(tex0,uv+offset.xz))-texelHeight(texture2D(tex0,uv-offset.xz));  '#10+
144. 'float ddY= texelHeight(texture2D(tex0,uv+offset.zy))-texelHeight(texture2D(tex0,uv-offset.zy));  '#10+
145.
146. 'ddX *=normal_strength/texel_offset;                                                              '#10+
147. 'ddY *=normal_strength/texel_offset;                                                              '#10+
148.
149. 'vec3 tangent=normalize(vec3(1.0,0.0,ddX));                                                       '#10+
150. 'vec3 bitangent=normalize(vec3(0.0,1.0,ddY));                                                     '#10+
151. 'vec3 normal=cross_emu(tangent,bitangent);                                                            '#10+
152.
153. 'vec2 lightPosition=0.5+0.4*vec2(cos(time),sin(time));                                            '#10+
154. 'vec3 lightColor=hsv2rgb(vec3(mod(time*0.1,1.0),0.1,1.0));                                        '#10+
155.
156. 'float lightStrength=10.0;                                                                        '#10+
157. 'float lightHeight=2.8;                                                                           '#10+
158.
159. 'vec3 lightDir=normalize(vec3(lightPosition,lightHeight)-worldPosition);                          '#10+
160. 'float attenuation=lightStrength/pow(distance(lightPosition,uv)+lightHeight,2.0);                 '#10+
161. 'float lambert=max(0.0,dot(lightDir,normal));                                                     '#10+
162. 'float blinnPhong=pow(max(dot(normalize(vec3(vec3(0.0,0.0,1.0))+normal),lightDir),0.0),10.0);     '#10+
163.
164. 'float ambient =0.0;                                                                              '#10+
165. 'float diff  =0.2*lambert;                                                                        '#10+
166. 'float specular =0.5*blinnPhong;                                                                  '#10+
167. 'vec3 col = vec3(ambient+(diff*surfaceColor+specular))*attenuation*lightColor;                    '#10+
168. 'float luma=luminance(col);                                                                       '#10+
169.
170. 'luma*=3.5;                                                                                       '#10+
171.
172. 'col /= luma/(luma+1.0);                                                                        '#10+
173.
174.
175.
176.
177. ' gl_FragColor = vec4(col, 1.0);                         '#10+
178.
179.
180.
181. '}',
182. 'varying vec2 texCoord;', '130');
183.
184.   FTime := UniformSingle['time'];      // float uniform
185.   Fintensity := UniformSingle['intensity'];
186.   FMode      := UniformInteger['c_mode'];
187.   FImage0    := UniformInteger['tex0'];
188.   FImage1    := UniformInteger['tex1'];
189.   FCanvasSize := UniformPointF['canvasSize'];
190.   FImage0V   := 0;
191.   FImage1V   := 1;
192.   FTimer := 0;
193.   FintensityV := 0.1;
194.   FModeV := 0;
195.
196.
197. end;
198.
199.
200. procedure TBGLBilateralFilter.StartUse;
201. begin
202.   inherited StartUse;
203.   FTime.Update;
204.   FTime.Value:=FTimer;
205.   FImage0.Update;
206.   FImage0.Value:=FImage0V;
207.   FImage1.Update;
208.   FImage1.Value:=FImage1V;
209.
210.   FIntensity.Update;
211.   Fintensity.Value:= FintensityV;
212.   FMode.Update;
213.   FMode.Value:= FModeV;
214.
215.
216. end;
217.
218. function TBGLBilateralFilter.Render(ATexture: IBGLTexture): IBGLTexture;
219. var previousBuf,buf: TBGLCustomFrameBuffer;
221. begin
222.
223.   previousBuf := Canvas.ActiveFrameBuffer;
224.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
225.   Canvas.ActiveFrameBuffer := buf;
226. // in case comment the two next line, if you not want to see black rectangle !!
227.   //-----------------------------------------------------------------
228. //  Canvas.Fill(BGRAPixelTransparent);
229. //  Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);
230.   //-----------------------------------------------------------------
233. //  BTexture.Bind(1);
234.   ATexture.Draw(0, 0);
236.   Canvas.ActiveFrameBuffer := previousBuf;
237.   result := buf.MakeTextureAndFree;
238.
239. end;
240.
241. end.

« Last Edit: August 20, 2024, 06:05:13 pm by Gigatron »
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

#### Gigatron

• Full Member
• Posts: 133
• Amiga Rulez !!
##### Re: Demo Scene BGRA GL Shader
« Reply #50 on: August 21, 2024, 05:15:50 pm »

Texure : WWW
Sfx :    dream weaver / Aurora

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, Spin,
9.   StdCtrls, BGRABitmap, BGRABitmapTypes, BGRABilateralFilter, BGLVirtualScreen,
10.   BGRAOpenGL, BGRAText,BGRATextFX,
11.   BGRAGradients,BGRAFontGL, RayLib , // raylib unit;
12.
13. BGRAOpenGL3D,   BGRACanvasGL, BGRAOpenGLType;
14.
15. type
16.
17.   { TForm1 }
18.
19.   TForm1 = class(TForm)
20.       BGLVirtualScreen1: TBGLVirtualScreen;
21.       OpenDialog1: TOpenDialog;
22.     Timer1: TTimer;
23.     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;
24.       ElapsedMs: integer);
26.       BGLContext: TBGLContext);
27.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
29.       BGLContext: TBGLContext);
30.
31.     procedure FormCreate(Sender: TObject);
32.     procedure FormDestroy(Sender: TObject);
33.     procedure Timer1Timer(Sender: TObject);
34.
35.    private
37.     GLBigFont: IBGLFont;
38.
39.     bigFont: TBGLRenderedFont;
40.
41.    public
42.     texture0,texture1,gl_surface : IBGLTexture;
43.     barreHaut,barreBas :IBGLTexture;
44.
45.   end;
46.
47. var
48.   Form1: TForm1;
49.   cmode,tm : integer;
50.   music:TMusic;
51.   master_vol : single;
52.
53.
54. implementation
55.
56. {\$R *.lfm}
57.
58. { TForm1 }
59.
60. procedure TForm1.FormCreate(Sender: TObject);
61. begin
62.
63.   cmode := 0;
64.   tm :=0;
65.
66.    // Initialization audio + load module
67.   InitAudioDevice();
68.   music := LoadMusicStream(PChar(GetApplicationDirectory + 'fletch.mod'));    // module nightlight
69.   master_vol := 0;
70.   music.looping := true;
71.   PlayMusicStream(music);
72.
73. end;
74.
75. procedure TForm1.FormDestroy(Sender: TObject);
76. begin
77.    // De-Initialization
79.  CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)
80. end;
81.
82. procedure TForm1.Timer1Timer(Sender: TObject);
83. begin
84.
85.  inc(tm);
86.
87.
88.  BGLVirtualScreen1.Invalidate;
89.
90. end;
91.
92. procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;
93.   BGLContext: TBGLContext; ElapsedMs: integer);
94.
95. begin
98.
100.      SetMasterVolume(master_vol);
101.      if( master_vol<1.0) then master_vol := master_vol + 0.01;
102.       UpdateMusicStream(music);
103. end;
104.
106.   BGLContext: TBGLContext);
107.   var bigRender: TBGRATextEffectFontRenderer;
109.
110.  begin
111.    texture0     := BGLTexture(ResourceFile('girl512-8.png'));  // texture must power of TWO size !!
112.    texture1     := BGLTexture(ResourceFile('gtr.png'));
113.    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
114.
116.     // les barres
117.     barreHaut     := BGLTexture(ResourceFile('barre_haut.png'));
118.     barreBas     := BGLTexture(ResourceFile('barre_bas.png'));
119.     // font
125.
128.     bigFont  := TBGLRenderedFont.Create(bigRender, true);
129.     bigFont.Name := 'paranoimia';
130.     bigFont.EmHeight := 48;
131.     //bigFont.Style:=[fsBold];
132.     GLBigFont := bigFont;
133.
134. end;
135.
136. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
137.   BGLContext: TBGLContext);
138.
139. begin
141.      // le traitement du sampler2D comme texture
145.      gl_surface := cmap_shader.Render(texture0,texture1);   // container de l'image0 affichee par le shader
146.      BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);
147.    //  bigFont.TextOut(0,5,'GIGATRON 15/08/2024');
148.    //  BGLContext.Canvas.PutImage(0,558,barreBas,255);
149.
150.
151. end;
152.
154.   BGLContext: TBGLContext);
155. begin
156.       // libere les textures et le shader !!
157.   texture0    := nil;
158.   texture1    := nil;
159.   gl_surface := nil;
160.   GLBigFont := nil;
161.   barreHaut:= nil;
162.   barreBas := nil;
164. end;
165.
166.
167. end.
168.

Code: Pascal  [Select][+][-]
2.
3. unit BGRABilateralFilter;
4.
5. {\$mode objfpc}{\$H+}
6.
7. interface
8.
9. uses
10.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
11.
12. type
13.
15.
16.   private
17.
18.   function GetCanvasSize: TPointF;
19.   procedure SetCanvasSize(AValue: TPointF);
20.
21.   protected
22.     // time
23.     FTime: TUniformVariableSingle;
24.     FTimer : Single;
25.     // intensity
26.     Fintensity  : TUniformVariableSingle;
27.     FintensityV : Single;
28.     // Color mode
29.     FMode  : TUniformVariableInteger;
30.     FModeV : Integer;
31.
32.     FImage0: TUniformVariableInteger;
33.     FImage0V : Integer;
34.     FImage1: TUniformVariableInteger;
35.     FImage1V : Integer;
36.
37.
38.     FCanvasSize: TUniformVariablePointF;
39.     procedure StartUse; override;
40.
41.   public
42.
43.     constructor Create(ACanvas: TBGLCustomCanvas);
44.     function Render(ATexture,BTexture: IBGLTexture): IBGLTexture; overload;
45.     procedure RenderOnCanvas;
46.     // propriete  ecriture des uniforms
47.     property Time: Single read FTimer write FTimer;
48.     property Intensity :  Single read FintensityV  write FintensityV;
49.     property Cmode :  integer read FModeV  write FModeV ;
50.
51.
52.     property Image0: integer read FImage0V write FImage0V;
53.     property Image1: integer read FImage1V write FImage1V;
54.
55.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
56.
57.
58.   end;
59.
60.   var  s_sin : single;
61.
62. implementation
63.
64. function TBGLBilateralFilter.GetCanvasSize: TPointF;
65. begin
66.   result := FCanvasSize.Value;
67. end;
68.
69. procedure TBGLBilateralFilter.SetCanvasSize(AValue: TPointF);
70. begin
71.   FCanvasSize.Value := AValue;
72. end;
73.
74.
75. { TBGLBilateralFilter }
76.
77. constructor TBGLBilateralFilter.Create(ACanvas: TBGLCustomCanvas);
78.
79. begin
80. // vertex
81. inherited Create(ACanvas,
82. 'uniform vec2 canvasSize;'#10 +
83. 'void main(void) {'#10 +
84. '  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +
85. ' // gl_FrontColor = gl_Color;'#10 +
86. ' //texCoord = gl_Vertex.xy / canvasSize;'#10 +
87. ' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +
88. '}',
89.
91. 'uniform float pixelWidth;                                '#10+
92. 'uniform float pixelHeight;                                '#10+
93. 'vec2 iResolution = vec2( 1./pixelWidth, 1./pixelHeight); '#10+
94. '//out vec4 FragmentColor;'#10 +
95. 'uniform float time;'#10+
96. 'uniform sampler2D img0;'#10+
97. 'uniform sampler2D img1;'#10+
98. 'uniform float intensity;                        '#10+
99. 'uniform int c_mode;                           '#10+
100.
101.
102. // Flag fx Gigatron
103.
104. 'void main()'#10 +
105. '{'#10 +
106. 'vec2 uv =  texCoord.xy   ;            '#10+
107. // flip y
108. ' uv.y = 1.-uv.y;                      '#10+
109. // resolution down
110. '//uv = floor(256.0*uv)/256.0;           '#10+
111. // texture xy_position
112. //'    vec2  xy_pos = vec2(0.09,0.25);'#10+
113.
114. 'float radius = 0.3  ;                                                                         '#10+
115. 'float zoom = 0.15 ;                                                                         '#10+
116. ' vec2 offset = vec2(0.5 * cos(time * 0.5), 0.50 * sin(time))*0.5,                                '#10+
117.
118. '      center = uv - vec2(0.50+offset.x,0.5+offset.y) ;                                               '#10+
119. '       center.x *= 512.0 / 512.0+0.33;                                                     '#10+
120. '                                                                                                      '#10+
121. ' float dist = length(center);                                                                         '#10+
122. ' if (dist > radius) {                                                                                 '#10+
123. '       gl_FragColor = texture2D(img0, uv);                                                    '#10+
124. '     return;                                                                                          '#10+
125. ' }                                                                                                    '#10+
126. ' //input                                                                                              '#10+
127. ' vec2 m = vec2(0.5,0.25);                                                                             '#10+
128. ' //light                                                                                              '#10+
129. ' vec3 lightLoc = vec3(m.x, m.y, radius),                                                              '#10+
130. '     lightLocDelta = normalize(vec3(offset - center,0.) - lightLoc),                                  '#10+
131. '     lightDir = vec3(lightLocDelta.xy, -sqrt(1. - pow(lightLocDelta.x,2.) - pow(lightLocDelta.y,2.))),'#10+
132. '     normal = normalize(vec3(center, sqrt(pow(radius,2.) - pow(center.x,2.) - pow(center.y,2.)))),    '#10+
133. '     bounce = reflect(lightDir, normal);                                                              '#10+
134. ' //diffuse light                                                                                      '#10+
135. ' float brightness = clamp(bounce.z, 0., 1.);                                                          '#10+
136. ' //dark effect                                                                                        '#10+
137. ' bounce = reflect(vec3(lightDir.xy, -lightDir.z), normal);                                            '#10+
138. ' float brightness2 = 1.7 - clamp(pow(bounce.z, 3.), 0., 1.);                                          '#10+
139. ' gl_FragColor = texture2D(img0, normal.xy * (zoom/normal.z) +  vec2(0.50+offset.x, 0.5+offset.y))                '#10+
140. '     * vec4(clamp(abs(normal), 0.5, 1.), 1.)                                                          '#10+
141. '     //falloff brightness with distance                                                               '#10+
142. '     * clamp(brightness2 - (0.05/normal.z), 0., 1.)                                                   '#10+
144. '     + vec4(pow(brightness, 10.));                                                                    '#10+
145.
146.
147. //'    gl_FragColor = vec4(tx1*tx0, 1.0);                         '#10+
148.
149.
150.
151. '}',
152. 'varying vec2 texCoord;', '130');
153.
154.   FTime := UniformSingle['time'];      // float uniform
155.   Fintensity := UniformSingle['intensity'];
156.   FMode      := UniformInteger['c_mode'];
157.   FImage0    := UniformInteger['img0'];
158.   FImage1    := UniformInteger['img1'];
159.   FCanvasSize := UniformPointF['canvasSize'];
160.   FImage0V   := 0;
161.   FImage1V   := 1;
162.   FTimer := 0;
163.   FintensityV := 0.1;
164.   FModeV := 0;
165.
166.
167. end;
168.
169.
170. procedure TBGLBilateralFilter.StartUse;
171. begin
172.   inherited StartUse;
173.   FTime.Update;
174.   FTime.Value:=FTimer;
175.   FImage0.Update;
176.   FImage0.Value:=FImage0V;
177.   FImage1.Update;
178.   FImage1.Value:=FImage1V;
179.
180.   FIntensity.Update;
181.   Fintensity.Value:= FintensityV;
182.   FMode.Update;
183.   FMode.Value:= FModeV;
184.
185.
186. end;
187.
188. function TBGLBilateralFilter.Render(ATexture,BTexture: IBGLTexture): IBGLTexture;
189. var previousBuf,buf: TBGLCustomFrameBuffer;
191. begin
192.
193.   previousBuf := Canvas.ActiveFrameBuffer;
194.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
195.   Canvas.ActiveFrameBuffer := buf;
196. // in case comment the two next line, if you not want to see black rectangle !!
197.   //-----------------------------------------------------------------
198.   Canvas.Fill(BGRAPixelTransparent);
199.
200.   Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);
201.   //-----------------------------------------------------------------
204.   BTexture.Bind(1);
205.   ATexture.Draw(0, 0);
206.   BTexture.Draw(0+64*sin(s_sin), -420);
208.   Canvas.ActiveFrameBuffer := previousBuf;
209.   result := buf.MakeTextureAndFree;
210.
211.   // canvas renderer
212.   //previousBuf := Canvas.ActiveFrameBuffer;
213.   //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
214.   //Canvas.ActiveFrameBuffer := buf;
215.   //Canvas.Fill(BGRAPixelTransparent);
216.   //RenderOnCanvas;
217.   //Canvas.ActiveFrameBuffer := previousBuf;
218.   //result := buf.MakeTextureAndFree;
219.
220.   s_sin := s_sin +0.02;
221. end;
222.
223. procedure TBGLBilateralFilter.RenderOnCanvas;
224. var
226. begin
229.   CanvasSize := PointF(800,600);
230.   Canvas.FillRect(0, 0, 800,600, CSSBlack);
232.
233. end;
234. end.
« Last Edit: August 23, 2024, 04:33:01 pm by Gigatron »
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

#### circular

• Hero Member
• Posts: 4333
##### Re: Demo Scene BGRA GL Shader
« Reply #51 on: August 23, 2024, 04:13:59 pm »
The elegant lense effect, cool
Conscience is the debugger of the mind

#### Gigatron

• Full Member
• Posts: 133
• Amiga Rulez !!
##### Re: Demo Scene BGRA GL Shader
« Reply #52 on: August 23, 2024, 04:24:54 pm »
The elegant lense effect, cool

Thank you @circular  the result with video : https://www.youtube.com/watch?v=lHe11_2K8bo

regards
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

#### Gigatron

• Full Member
• Posts: 133
• Amiga Rulez !!
##### Re: Demo Scene BGRA GL Shader
« Reply #53 on: August 28, 2024, 02:58:32 am »
Hi,
Here is another Amiga Style rotozoom example using BGRA GL fragment shader;

Result on YT :

Main unit;

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,
9.   StdCtrls, BGRABitmap, BGRABitmapTypes,   BGLVirtualScreen,
10.   BGRAOpenGL, BGRAText,BGRATextFX,BGRARotozoom,
11.   BGRAGradients,BGRAFontGL, raylib  ; // raylib unit;
12.
13.
14. type
15.
16.   { TForm1 }
17.
18.   TForm1 = class(TForm)
19.     BGLVirtualScreen1: TBGLVirtualScreen;
20.     Timer1: TTimer;
21.
22.     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;
23.       ElapsedMs: integer);
25.       BGLContext: TBGLContext);
26.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
28.       BGLContext: TBGLContext);
29.     procedure FormDestroy(Sender: TObject);
30.
31.     procedure Timer1Timer(Sender: TObject);
32.     procedure FormCreate(Sender: TObject);
33.
34.
35.    private
37.     GLBigFont: IBGLFont;
38.     bigFont: TBGLRenderedFont;
39.
40.    public
41.     texture0,gl_surface : IBGLTexture;
42.     barreHaut,barreBas :IBGLTexture;
43.
44.   end;
45.
46. var
47.   Form1: TForm1;
48.   music:TMusic;
49.   master_vol : single;
50.   alfa : byte;
51.   message_index,alfa_time : integer;
52.
53.   message : Array[0..27] Of String =('  GIGATRON PRESENTS    ',
55.                                      '                       ',
56.                                      ' SFX BY : MEGAWATT AND ',
57.                                      '    THE SOUND LEGEND   ',
58.                                      '***********************',
59.                                      '   DEMO PROGRAMMED BY  ',
60.                                      'GIGATRON ON 22/08/2024 ',
61.                                      '***********************',
62.                                      '                       ',
63.                                      'GREETINGS LIST IN ORDER',
64.                                      '   CIRCULAR FOR BGRA    ',
65.                                      '    GUVACODE RAYLAZ     ',
66.                                      '   RAYSAN FOR RAYLIB    ',
67.                                      'ETOWNER, STATIC Z, DSR3 ',
68.                                      'TONY, TRONIC DESIGN AND ',
69.                                      '  PARALLAX, SUB-SERO    ',
70.                                      '  THE LAZARUS FPC STAFF ',
71.                                      '    SUB QUANTUM TECH    ',
72.                                      '  BLIZZARD RAZOR-1911   ',
73.                                      '   SUB-SERO TBL BRONX   ',
74.                                      '   ANTI BYTE OFFA SIM   ',
75.                                      '   PHENOMENA NORT-STAR  ',
76.                                      '   COMPLEX  RED-SECTOR  ',
77.                                      '    WARM STAR DEFJAM    ',
78.                                      'AMIGA THE BEST COMPUTER ',
79.                                      '     AND ALL THE REST   ',
80.                                      '   WE ARE NOT ALONE !!! ');
81.
82.
83. implementation
84.
85. {\$R *.lfm}
86.
87. { TForm1 }
88.
89. procedure TForm1.FormCreate(Sender: TObject);
90. begin
91.
92.  alfa :=0;
93.  message_index :=0;
94.  alfa_time :=0;
95.    // Initialization audio + load module
96.   InitAudioDevice();
97.   music := LoadMusicStream(PChar(GetApplicationDirectory + 'abandon.xm'));    //   module
98.   master_vol := 0.0;
99.   music.looping := true;
100.   PlayMusicStream(music);
101.
102. end;
103.
104.
105. procedure TForm1.Timer1Timer(Sender: TObject);
106. begin
108.
109.   if( alfa<255) then inc(alfa);
110.   if(alfa>=255) then
111.   begin
112.     inc(alfa_time);
113.     alfa :=255;
114.     if (alfa_time>100) then
115.     begin
116.      alfa:=0;
117.      inc(message_index);
118.      alfa_time :=0;
119.      if message_index >=28 then message_index :=0;
120.     end;
121.
122.   end;
123.
124.   BGLVirtualScreen1.Invalidate;
125.  end;
126.
127.
128.
130.   BGLContext: TBGLContext);
131.   var bigRender: TBGRATextEffectFontRenderer;
133.  begin
134.    texture0     := BGLTexture(ResourceFile('girl512-7.jpg'));  // texture must power of TWO size !!
135.    gl_surface := BGLTexture(ResourceFile('gl_surface.jpg'));
136.
138.    // les barres
139.     barreHaut     := BGLTexture(ResourceFile('barre_haut.png'));
140.     barreBas     := BGLTexture(ResourceFile('barre_bas.png'));
141.     // font
150.     bigFont  := TBGLRenderedFont.Create(bigRender, true);
151.     bigFont.Name := 'fairlight';
152.     bigFont.EmHeight := 44;
153.     //bigFont.Style:=[fsBold];
154.     GLBigFont := bigFont;
155.
156. end;
157.
158. procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;
159.   BGLContext: TBGLContext; ElapsedMs: integer);
160. begin
161.           // Module play
162.      SetMasterVolume(master_vol);
163.      if( master_vol<1.0) then master_vol := master_vol + 0.1;
164.       UpdateMusicStream(music);
165.
166. end;
167.
168. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
169.   BGLContext: TBGLContext);
170. begin
171.
172.      // le traitement du sampler2D comme texture
175.      gl_surface := roto_zoom_shader.Render(texture0);   // container de l'image0 affichee par le shader
176.      BGLContext.Canvas.PutImage(0,0,texture0,255);
177.      BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);
178.      BGLContext.Canvas.PutImage(0,558,barreBas,255);
179.      bigFont.TextOut(0,550,message[message_index],BGRA(225,0,0,alfa));
180.
181.
182. end;
183.
185.   BGLContext: TBGLContext);
186. begin
187.       // libere les textures et le shader !!
188.   texture0    := nil;
189.   gl_surface := nil;
190.   GLBigFont := nil;
191.   barreHaut:= nil;
192.   barreBas := nil;
194.
195. end;
196.
197. procedure TForm1.FormDestroy(Sender: TObject);
198. begin
199.  // De-Initialization
201.  CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)
202. end;
203.
204.
205. end.
206.

Rotozoom Shader Unit quite simple :
Code: Pascal  [Select][+][-]
2.
3. unit BGRARotozoom;
4.
5. {\$mode objfpc}{\$H+}
6.
7. interface
8.
9. uses
10.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
11.
12. type
13.
15.
16.   private
17.   function GetCanvasSize: TPointF;
18.   procedure SetCanvasSize(AValue: TPointF);
19.
20.   protected
21.     // time
22.     FTime: TUniformVariableSingle;
23.     FTimer : Single;
24.
25.     FImage0: TUniformVariableInteger;
26.     FImage0V : Integer;
27.
28.     FCanvasSize: TUniformVariablePointF;
29.     procedure StartUse; override;
30.
31.   public
32.
33.     constructor Create(ACanvas: TBGLCustomCanvas);
34.     function Render(ATexture: IBGLTexture): IBGLTexture; overload;
35.
36.     // propriete  ecriture des uniforms
37.     property Time: Single read FTimer write FTimer;
38.
39.     property Image0: integer read FImage0V write FImage0V;
40.
41.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
42.
43.   end;
44.
45. implementation
46.
47. function TBGLRotozoom.GetCanvasSize: TPointF;
48. begin
49.   result := FCanvasSize.Value;
50. end;
51.
52. procedure TBGLRotozoom.SetCanvasSize(AValue: TPointF);
53. begin
54.   FCanvasSize.Value := AValue;
55. end;
56.
57.
58. { TBGLBilateralFilter }
59.
60. constructor TBGLRotozoom.Create(ACanvas: TBGLCustomCanvas);
61.
62. begin
63. // vertex
64. inherited Create(ACanvas,
65. 'uniform vec2 canvasSize;'#10 +
66. 'void main(void) {'#10 +
67. '  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +
68. '  gl_FrontColor = gl_Color;'#10 +
69. ' //texCoord = gl_Vertex.xy / canvasSize;'#10 +
70. ' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +
71. '}',
72.
74. '//out vec4 FragmentColor;'#10 +
75. 'uniform float time;'#10+
76. 'uniform sampler2D tex;'#10+
77.
78.
79. 'void main()'#10 +
80. '{'#10 +
81. 'vec2 uv =  texCoord.xy -0.5    ;                            '#10+
82. // flip y
83. '  uv.y = 1.0-uv.y;                                           '#10+
84. // resolution down
85.  'uv = floor(256.0*uv)/256.0;'#10+
86. // texture xy_position
87. //'    vec2  xy_pos = vec2(0.09,0.25);'#10+
88.
89. '    uv *= 10.0;                                                    '#10+
90. '    uv *= sin(2.0*time);                                              '#10+
91. '    uv *= mat2(cos(time),-sin(time),sin(time),cos(time));         '#10+
92. '    // Output to screen                                           '#10+
93. '    gl_FragColor = texture2D(tex,vec2(uv.x/2.5,uv.y/2.5));        '#10+
94.
95. //' gl_FragColor = vec4(1.0,0.4,0.0, 1.0);                        '#10+
96.
97.
98.
99. '}',
100. 'varying vec2 texCoord;', '130');
101.
102.   FTime := UniformSingle['time'];      // float uniform
103.   FImage0    := UniformInteger['tex'];
104.   FCanvasSize := UniformPointF['canvasSize'];
105.
106.   FImage0V   := 0;
107.   FTimer := 0.0;
108.
109. end;
110.
111.
112. procedure TBGLRotozoom.StartUse;
113. begin
114.   inherited StartUse;
115.    FTime.Update;
116.    FTime.Value:=FTimer;
117.    FImage0.Update;
118.    FImage0.Value:=FImage0V;
119.
120.
121.
122. end;
123.
124. function TBGLRotozoom.Render(ATexture: IBGLTexture): IBGLTexture;
125. var previousBuf,buf: TBGLCustomFrameBuffer;
127. begin
128.
129.   previousBuf := Canvas.ActiveFrameBuffer;
130.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
131.   Canvas.ActiveFrameBuffer := buf;
132.
133. // in case comment the two next line, if you not want to see black rectangle !!
134.   //-----------------------------------------------------------------
135.   //   Canvas.Fill(BGRAPixelTransparent);
136.   //   Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);
137.   //-----------------------------------------------------------------
140.
141.   ATexture.Draw(0, 0);
143.   Canvas.ActiveFrameBuffer := previousBuf;
144.   result := buf.MakeTextureAndFree;
145.
146.
147. end;
148.
149.
150. end.
« Last Edit: August 28, 2024, 03:03:43 am by Gigatron »
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

#### Gigatron

• Full Member
• Posts: 133
• Amiga Rulez !!
##### Re: Demo Scene BGRA GL Shader
« Reply #54 on: August 29, 2024, 02:59:27 pm »
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 .

Regards Gtr

The main unit :

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,
9.   StdCtrls, BGRABitmap, BGRABitmapTypes,   BGLVirtualScreen,
10.   BGRAOpenGL, BGRAText,BGRATextFX,BGRASteam,
11.   BGRAGradients,BGRAFontGL, raylib  ; // raylib unit;
12.
13.
14. type
15.
16.   { TForm1 }
17.
18.   TForm1 = class(TForm)
19.     BGLVirtualScreen1: TBGLVirtualScreen;
20.     Timer1: TTimer;
21.
22.     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;
23.       ElapsedMs: integer);
25.       BGLContext: TBGLContext);
26.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
28.       BGLContext: TBGLContext);
29.     procedure FormDestroy(Sender: TObject);
30.
31.     procedure Timer1Timer(Sender: TObject);
32.     procedure FormCreate(Sender: TObject);
33.
34.    private
36.     GLBigFont: IBGLFont;
37.     bigFont: TBGLRenderedFont;
38.
39.    public
40.     texture0,gl_surface,barreBas,gtr : IBGLTexture;
41.
42.   end;
43.
44. var
45.   Form1: TForm1;
46.   music:TMusic;
47.   master_vol : single;
48.   message_index,alfa_time : integer;
49.   s_sin : single;
50.   alfa_id : integer;
51.   f_intensity : single;
52.   alfa : Array[0..60] of Byte =(0,10,20,30,40,50,60,70,80,90,100,110,120,130,140,150,160,170,
53.                                 180,190,200,210,220,230,240,250,255,255,255,255,255,255,255,255,
54.                                 255,250,240,230,220,210,200,190,180,170,160,150,140,130,120,110,
55.                                 100,90,80,70,60,50,40,30,20,10,0);
56.
57.   message : Array[0..23] Of String =('   GIGATRON PRESENTS    ',
58.                                      '  BGRA GL STEAM SHADER  ',
59.                                      'SFX : CHROMAG/TALENT HJB',
60.                                      '   PROTRACKER MODULE    ',
61.                                      '   DEMO PROGRAMMED BY   ',
62.                                      ' GIGATRON ON 24/08/2024 ',
63.                                      ' GREETINGS LIST IN ORDER',
64.                                      '   CIRCULAR FOR BGRA    ',
65.                                      '    GUVACODE RAYLAZ     ',
66.                                      '   RAYSAN FOR RAYLIB    ',
67.                                      'ETOWNER, STATIC Z, DSR3 ',
68.                                      '  LILLY, TRONIC DESIGN  ',
69.                                      '  PARALLAX, SUB-SERO    ',
70.                                      '  THE LAZARUS FPC STAFF ',
71.                                      '    SUB QUANTUM TECH    ',
72.                                      '  BLIZZARD RAZOR-1911   ',
73.                                      '   SUB-SERO TBL BRONX   ',
74.                                      '   ANTI BYTE OFFA SIM   ',
75.                                      '   PHENOMENA NORT-STAR  ',
76.                                      '   COMPLEX  RED-SECTOR  ',
77.                                      '    STAR-COM DEFJAM     ',
78.                                      'AMIGA THE BEST COMPUTER ',
79.                                      '    AND ALL THE REST    ',
80.                                      '   WE ARE NOT ALONE !!! ');
81.   pos_y,logo_x : integer;
82.
83.
84. implementation
85.
86. {\$R *.lfm}
87.
88. { TForm1 }
89.
90. procedure TForm1.FormCreate(Sender: TObject);
91. begin
92.
93.  alfa_id :=0;
94.  message_index :=0;
95.  alfa_time :=0;
96.  s_sin := 0;
97.  pos_y :=0;
98.  f_intensity :=0.0;
99.    // Initialization audio + load module
100.   InitAudioDevice();
101.   music := LoadMusicStream(PChar(GetApplicationDirectory + 'chromag-shock_therapy23.xm')); //   module
102.   master_vol := 0.0;
103.   music.looping := true;
104.   PlayMusicStream(music);
105.
106. end;
107.
108.
109. procedure TForm1.Timer1Timer(Sender: TObject);
110. begin
113.     s_sin := s_sin +0.06;
114.     inc(alfa_time);
115.
116.     if (pos_y >=60) then
117.     begin
118.     if (alfa_time>5) then
119.     begin
120.      alfa_id :=alfa_id +1;
121.      if(alfa_id>=High(alfa)) then
122.      begin
123.           inc(message_index);
124.           alfa_id := 0;
125.          if message_index >=24 then message_index :=0;
126.      end;
127.           alfa_time :=0;
128.           if(f_intensity<1.4) then  f_intensity := f_intensity +0.004;
129.      end;
130.
131.     end;
132.     if (pos_y < 60) then pos_y := pos_y + 2 ;
133.     if (logo_x>-2460) then  logo_x := logo_x - 2 ;
134.
135.   BGLVirtualScreen1.Invalidate;
136.  end;
137.
138.
139.
141.   BGLContext: TBGLContext);
142.   var bigRender: TBGRATextEffectFontRenderer;
144.  begin
145.    texture0  := BGLTexture(ResourceFile('girl512-8.jpg'));  // texture must power of TWO size !!
146.    gtr       := BGLTexture(ResourceFile('gtr2.png'));
147.    gl_surface:= BGLTexture(ResourceFile('gl_surface.jpg'));
148.
150.     // barre
151.     barreBas     := BGLTexture(ResourceFile('barre_bas.png'));
152.     // font
161.     bigFont  := TBGLRenderedFont.Create(bigRender, true);
162.     bigFont.Name := 'Affirmative';
163.     bigFont.EmHeight := 54;
164.     //bigFont.Style:=[fsBold];
165.     GLBigFont := bigFont;
166.
167. end;
168.
169. procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;
170.   BGLContext: TBGLContext; ElapsedMs: integer);
171. begin
172.           // Module play
173.      SetMasterVolume(master_vol);
174.      if( master_vol<1.0) then master_vol := master_vol + 0.1;
175.      UpdateMusicStream(music);
176.
177. end;
178.
179. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
180.   BGLContext: TBGLContext);
181. begin
182.
183.      gl_surface := steam_shader.Render(texture0);   // container texture0 no need to draw else;
184.      BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);
185.      BGLContext.Canvas.PutImage(0,608-pos_y,barreBas,255);
186.      bigFont.TextOut(20+64*sin(s_sin),494+40,message[message_index], BGRA(0,100,255,alfa[alfa_id]));
187.
188.      BGLContext.Canvas.PutImage(800+logo_x,100, gtr);
189. end;
190.
192.   BGLContext: TBGLContext);
193. begin
194.   // libere les textures et le shader et le Font gl !!
195.   texture0    := nil;
196.   gtr         := nil;
197.   gl_surface  := nil;
198.   GLBigFont   := nil;
199.   barreBas    := nil;
201.
202. end;
203.
204. procedure TForm1.FormDestroy(Sender: TObject);
205. begin
206.  // De-Initialization
208.  CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)
209. end;
210.
211.
212. end.
213.

Code: Pascal  [Select][+][-]
2.
3. unit BGRASteam;
4.
5. {\$mode objfpc}{\$H+}
6.
7. interface
8.
9. uses
10.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
11.
12. type
13.
15.
16.   private
17.   function GetCanvasSize: TPointF;
18.   procedure SetCanvasSize(AValue: TPointF);
19.
20.   protected
21.     // time
22.     FTime: TUniformVariableSingle;
23.     FTimer : Single;
24.     // intensity
25.     FIntensity  : TUniformVariableSingle;
26.     FIntensityV : Single;
27.
28.     FImage0: TUniformVariableInteger;
29.     FImage0V : Integer;
30.
31.     FCanvasSize: TUniformVariablePointF;
32.     procedure StartUse; override;
33.
34.   public
35.
36.     constructor Create(ACanvas: TBGLCustomCanvas);
37.     function Render(ATexture: IBGLTexture): IBGLTexture; overload;
38.
39.     // propriete  ecriture des uniforms
40.     property Time: Single read FTimer write FTimer;
41.     property Intensity: Single read FIntensityV write FIntensityV;
42.
43.     property Image0: integer read FImage0V write FImage0V;
44.
45.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
46.
47.   end;
48.
49. implementation
50.
51. function TBGLSteam.GetCanvasSize: TPointF;
52. begin
53.   result := FCanvasSize.Value;
54. end;
55.
56. procedure TBGLSteam.SetCanvasSize(AValue: TPointF);
57. begin
58.   FCanvasSize.Value := AValue;
59. end;
60.
61.
62. { TBGLSteam }
63.
64. constructor TBGLSteam.Create(ACanvas: TBGLCustomCanvas);
65.
66. begin
67. inherited Create(ACanvas,
68. // vertex
69. 'uniform vec2 canvasSize;'#10 +
70. 'void main(void) {'#10 +
71. '  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +
72. '  gl_FrontColor = gl_Color;'#10 +
73. ' //texCoord = gl_Vertex.xy / canvasSize;'#10 +
74. ' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +
75. '}',
76.
78. 'uniform float time;'#10+
79. 'uniform sampler2D tex;'#10+
80. 'uniform float intensity;'#10+
81.
82. 'float random(vec2 pos) {                                                          '#10+
83. '       return fract(1.0 * sin(pos.y + fract(80.0 * sin(pos.x))));                     '#10+
84. '}                                                                                 '#10+
85. '                                                                                  '#10+
86. 'float noise(vec2 pos) {                                                           '#10+
87. '       vec2 i = floor(pos);                                                           '#10+
88. '       vec2 f = fract(pos);                                                           '#10+
89. '       float a = random(i + vec2(0.0, 0.0));                                          '#10+
90. '       float b = random(i + vec2(1.0, 0.0));                                          '#10+
91. '       float c = random(i + vec2(0.0, 1.0));                                          '#10+
92. '       float d = random(i + vec2(1.0, 1.0));                                          '#10+
93. '       vec2 u = f * f * (3.0 - 2.0 * f);                                              '#10+
94. '       return mix(a, b, u.x) + (c - a) * u.y * (1.0 - u.x) + (d - b) * u.x * u.y;     '#10+
95. '}                                                                                     '#10+
96.
97. 'float fbm(vec2 pos) {                                                                 '#10+
98. '       float v = 0.0;                                                                 '#10+
99. '       float a = 0.5;                                                                 '#10+
100. '       vec2 shift = vec2(100.0);                                                      '#10+
101. '       mat2 rot = mat2(cos(0.15), sin(0.15), -sin(0.25), cos(0.5));                   '#10+
102. '       for (int i=0; i < 12; i++) {                                                   '#10+
103. '               v += a * noise(pos);                                                   '#10+
104. '               pos = rot * pos * 2. + shift;                                          '#10+
105. '               a *= 0.55;                                                             '#10+
106. '       }                                                                              '#10+
107. '       return v;                                                                      '#10+
108. '}                                                                                     '#10+
109.
110. 'void main()'#10 +
111. '{'#10 +
112. 'vec2 uv =  texCoord.xy     ;                                            '#10+
113. // flip y
114. '  uv.y = 1.0-uv.y;                                                      '#10+
115. // resolution down
116.  'uv = floor(512.0*uv)/512.0;'#10+
117. // texture xy_position
118. //'vec2  xy_pos = vec2(0.09,0.25);'#10+
119.
120. '  float f = fbm(uv * 30.0 * vec2(fbm(uv - (time / 10.0)), fbm(uv * 1.0 + (time / 20.0))));'#10+
121. '  vec3 c = f*texture2D(tex, uv-vec2(-0.028*f,0.014*f)).xyz;                               '#10+
122. '  gl_FragColor = vec4(c, 1.0)*intensity;                                                  '#10+
123.
124. //' gl_FragColor = vec4(1.0,0.4,0.0, 1.0);                        '#10+ // debug
125.
126.
127. '}',
128. 'varying vec2 texCoord;', '130');
129.
130.   FTime      := UniformSingle['time'];      // float uniform
131.   FIntensity := UniformSingle['intensity'];
132.   FImage0    := UniformInteger['tex'];
133.   FCanvasSize := UniformPointF['canvasSize'];
134.
135.   FImage0V   := 0;
136.   FTimer := 0.0;
137.   FIntensityV := 0.0;
138. end;
139.
140.
141. procedure TBGLSteam.StartUse;
142. begin
143.   inherited StartUse;
144.    FTime.Update;
145.    FTime.Value:=FTimer;
146.    FIntensity.Update;
147.    FIntensity.Value:=FIntensityV;
148.    FImage0.Update;
149.    FImage0.Value:=FImage0V;
150.
151.
152.
153. end;
154.
155. function TBGLSteam.Render(ATexture: IBGLTexture): IBGLTexture;
156. var previousBuf,buf: TBGLCustomFrameBuffer;
158. begin
159.
160.   previousBuf := Canvas.ActiveFrameBuffer;
161.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
162.   Canvas.ActiveFrameBuffer := buf;
163.
164. // in case comment the two next line, if you not want to see black rectangle !!
165.   //-----------------------------------------------------------------
166.   //   Canvas.Fill(BGRAPixelTransparent);
167.   //   Canvas.FillRect(0, 0, ATexture.Width, ATexture.Height, CSSBlack);
168.   //-----------------------------------------------------------------
171.
172.   ATexture.Draw(0, 0);