Demo Scene BGRA GL Shader

[Gigatron]

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   BGLVirtualScreen, BGRAOpenGL, BGRACheckerBoardGL, BGRABitmapTypes,mmsystem;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGLVirtualScreen1: TBGLVirtualScreen;
17.     Timer1: TTimer;
18.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
19.       BGLContext: TBGLContext);
20.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
21.     procedure BGLVirtualScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);
22.     procedure FormCreate(Sender: TObject);
23.     procedure Timer1Timer(Sender: TObject);
24.   private
25.     gtr_logo,gl_surface: IBGLTexture;
26.     logo_xpos : integer;
27.     checker: TBGLCheckerBoardShader;
28.     MainFont: IBGLFont;
29.     line_message :Array of PChar;
30.     LineXpos,   LineYpos : Single;
31.  
32.     // dot plot
33.     s,a : single;
34.     alfa,alfa_time,plot_dir : integer;
35.   public
36.  
37.   MyAudio_File: AnsiString;
38.   WavStream : TMemoryStream;
39.  
40.   end;
41.  
42. var
43.   Form1: TForm1;
44.  
45. implementation
46. uses  GL;
47.  
48. {$R *.lfm}
49.  
50. { TForm1 }
51.  
52.  
53. procedure TForm1.FormCreate(Sender: TObject);
54. begin
55.   MainFont := BGLFont('AmigaParadox',40);
56.  
57.   SetLength(line_message, 1);
58.   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 ........');
59.   LineXPos := 3000;
60.   LineYpos := 440;
61.   // plot fx
62.    s := 255/sqrt(3)*2/30;
63.    a := 0.0;  // angle
64.    alfa :=0;
65.    // logo x pos
66.    logo_xpos:= -800;
67.  
68.     // audio stream
69.     MyAudio_File := 'euskal.wav';
70.     WavStream    := TMemoryStream.Create;
71.     WavStream.LoadFromFile(MyAudio_File);
72.     PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY);
73.  
74. end;
75.  
76. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
77. var gl_pix: IBGLTexture;
78.   i : integer;
79.  
80.   xx,yy : integer;
81.   r,z,x1,x2,y1,y2 : single;
82.  
83. begin
84.     checker.Time:= checker.Time +0.030;
85.     gl_pix := checker.Render(gl_surface );
86.     BGLContext.Canvas.PutImage(0,0, gl_pix);
87.     BGLContext.Canvas.PutImage(logo_xpos,0, gtr_logo);
88.  
89.  
90.      for  i := 0 to  Length(line_message[0])-1 do
91.     begin
92.      if LinexPos < -Length(line_message[0]) * 22  then LinexPos := 800;
93.      LinexPos := LineXPos - 0.015;
94.      LineyPos := 460;
95.      MainFont.TextOut(i * 22  + LinexPos+5,(  LineYPos   )+5, line_message[0][i]);
96.     end;
97.  
98.   // plot fx
99.       for xx:=15 downto -15 do
100.        begin
101.        for yy:=15 downto -15 do
102.         begin
103.  
104.        r := (sqrt(xx*xx+yy*yy))+2;
105.        z := 40*sin(r+a*0.6)/r*0.8;
106.  
107.        x2 := xx*cos(a*PI/180)-yy*sin(a*PI/180);
108.        y2 := xx*sin(a*PI/180)+yy*cos(a*PI/180);
109.  
110.        x1 := round(360+(y2-x2)*s*sqrt(3)/2);
111.        y1 := round(300+z-(y2+x2)*s/2);
112.  
113.        BGLContext.Canvas.Rectangle(Rect(Round(x1), Round(y1),Round(x1+2), Round(y1+2)),BGRA(alfa,alfa,alfa));
114.  
115.         end;
116.        end;
117.  
118.       if(plot_dir=1) then  a := a + 0.2;
119.       if(plot_dir=2) then  a := a - 0.2;
120.  
121. end;
122.  
123. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
124.   BGLContext: TBGLContext);
125. begin
126.  
127.   gtr_logo := BGLTexture(ResourceFile('gtr.png'));
128.   gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
129.  
130.   checker := TBGLCheckerBoardShader.Create(BGLContext.Canvas);
131.  
132. end;
133.  
134. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
135.   BGLContext: TBGLContext);
136. begin
137.   gl_surface := nil;
138.   gtr_logo   := nil;
139.   FreeAndNil(checker);
140.  
141. end;
142.  
143.  
144. procedure TForm1.Timer1Timer(Sender: TObject);
145. begin
146.       inc(alfa);
147.       if (alfa>=254) then alfa :=255;
148.  
149.       inc(alfa_time);
150.       if(alfa_time>300+Random(450)) then
151.       begin
152.         alfa_time :=0;
153.         plot_dir := 1+Random(2);
154.       end;
155.  
156.       inc(logo_xpos,5);
157.       if(logo_xpos>=30) then logo_xpos :=30;
158.  
159.       BGLVirtualScreen1.Invalidate;
160. end;
161.  
162. end.
163.  

Checker Board shader unit hope no mistake inside ;

Code: Pascal  [Select][+][-]

1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
2.  
3. { Checkerboard effect using OpenGL shaders }
4. unit BGRACheckerBoardGL;
5.  
6. {$mode objfpc}{$H+}
7.  
8. interface
9.  
10. uses
11.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
12.  
13. type
14.   { Shader computing Checkerboard }
15.   TBGLCheckerBoardShader = class(TBGLShader3D)
16.   private
17.     function GetImageIndex: integer;
18.     function GetTime: Single;
19.     procedure SetImageIndex(AValue: integer);
20.     procedure SetTime(AValue: Single);
21.  
22.   protected
23.  
24.     FImageIndex: TUniformVariableInteger;
25.     FTime:     TUniformVariableSingle;
26.     procedure StartUse; override;
27.  
28.   public
29.     constructor Create(ACanvas: TBGLCustomCanvas);
30.     function Render(ATexture: IBGLTexture): IBGLTexture; overload;
31.     property ImageIndex: integer read GetImageIndex write SetImageIndex;
32.     property Time: Single read GetTime write SetTime;
33.  
34.   end;
35.  
36. implementation
37.  
38. { TBGLCheckerBoardShader }
39.  
40. function TBGLCheckerBoardShader.GetImageIndex: integer;
41. begin
42.   result := FImageIndex.Value;
43. end;
44.  
45. function TBGLCheckerBoardShader.GetTime: Single;
46. begin
47.   result := FTime.Value;
48. end;
49.  
50. procedure TBGLCheckerBoardShader.SetImageIndex(AValue: integer);
51. begin
52.   FImageIndex.Value := AValue;
53. end;
54.  
55. procedure TBGLCheckerBoardShader.SetTime(AValue: Single);
56. begin
57.     FTime.Value := AValue;
58. end;
59.  
60. constructor TBGLCheckerBoardShader.Create(ACanvas: TBGLCustomCanvas);
61.  
62. begin
63. // vertex + fragment
64. inherited Create(ACanvas,
65. 'void main(void) {'#10 +
66. '       gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +
67. '    texCoord = vec2(gl_MultiTexCoord0);'#10 +
68. '}',
69.  
70. 'uniform sampler2D image;'#10 +
71. 'uniform float time;'#10 +
72. 'out vec4 FragmentColor;'#10 +
73.  
74. 'void main(void)'#10 +
75. '{'#10 +
76. 'vec2 pos = texCoord - vec2(0.5,0.5);     '#10 +
77. ' float horizon = 0.0;  '#10 +
78. ' float fov = 0.5;      '#10 +
79. ' float scaling = 0.4;  '#10 +
80. ' vec3 p = vec3(pos.x, fov, pos.y - horizon);'#10 +
81. ' vec2 s = vec2(p.x/p.z, p.y/p.z) * scaling; '#10 +
82. ' float f = 1.0;                             '#10 +
83. ' //checkboard                               '#10 +
84. ' 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 +
85. ' col *= p.z*p.z*5.0*(1.0 - abs(p.x));'#10 +
86.  
87. ' FragmentColor = vec4( vec3(col*1.0,col*0.0,col*0.0), 1.0 ); '#10 +
88.  
89. '}',
90.  
91. 'varying vec2 texCoord;', '130');
92.  
93.   FImageIndex := UniformInteger['image'];
94.   FTime := UniformSingle['time'];      // float uniform
95.   ImageIndex:= 0;
96.   Time := 0;
97. end;
98.  
99. function TBGLCheckerBoardShader.Render(ATexture: IBGLTexture): IBGLTexture;
100. var previousBuf,buf: TBGLCustomFrameBuffer;
101.   previousShader: TBGLCustomShader;
102. begin
103.   previousBuf := Canvas.ActiveFrameBuffer;
104.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
105.   Canvas.ActiveFrameBuffer := buf;
106.   Canvas.Fill(BGRAPixelTransparent);
107.   previousShader := Canvas.Lighting.ActiveShader;
108.   Canvas.Lighting.ActiveShader := self;
109.   ATexture.Draw(0, 0);
110.   Canvas.Lighting.ActiveShader := previousShader;
111.   Canvas.ActiveFrameBuffer := previousBuf;
112.   result := buf.MakeTextureAndFree;
113. end;
114.  
115. procedure TBGLCheckerBoardShader.StartUse;
116. begin
117.   inherited StartUse;
118.   FImageIndex.Update;
119.   FTime.Update;
120. end;
121.  
122. end.
123.  

[Joanna]

I don’t know much about this type of programming but I enjoyed your video. I like the old style simple sounds.

[Gigatron]

I 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]

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

1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
2.  
3. { Checkerboard effect using OpenGL shaders }
4. unit BGRACheckerBoardGL;
5.  
6. {$mode objfpc}{$H+}
7.  
8. interface
9.  
10. uses
11.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
12.  
13. type
14.   { Shader computing Checkerboard }
15.   TBGLCheckerBoardShader = class(TBGLShader3D)
16.   private
17.     function GetCanvasSize: TPointF;
18.     function GetTime: Single;
19.     procedure SetCanvasSize(AValue: TPointF);
20.     procedure SetTime(AValue: Single);
21.  
22.   protected
23.  
24.     FCanvasSize: TUniformVariablePointF;
25.     FTime:     TUniformVariableSingle;
26.     procedure StartUse; override;
27.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
28.  
29.   public
30.     constructor Create(ACanvas: TBGLCustomCanvas);
31.     function Render(AWidth, AHeight: integer): IBGLTexture; overload;
32.     procedure RenderOnCanvas;
33.     property Time: Single read GetTime write SetTime;
34.  
35.   end;
36.  
37. implementation
38.  
39. { TBGLCheckerBoardShader }
40.  
41. function TBGLCheckerBoardShader.GetCanvasSize: TPointF;
42. begin
43.   result := FCanvasSize.Value;
44. end;
45.  
46. function TBGLCheckerBoardShader.GetTime: Single;
47. begin
48.   result := FTime.Value;
49. end;
50.  
51. procedure TBGLCheckerBoardShader.SetCanvasSize(AValue: TPointF);
52. begin
53.   FCanvasSize.Value := AValue;
54. end;
55.  
56. procedure TBGLCheckerBoardShader.SetTime(AValue: Single);
57. begin
58.     FTime.Value := AValue;
59. end;
60.  
61. constructor TBGLCheckerBoardShader.Create(ACanvas: TBGLCustomCanvas);
62.  
63. begin
64. // vertex + fragment
65. inherited Create(ACanvas,
66. 'uniform vec2 canvasSize;'#10 +
67. 'void main(void) {'#10 +
68. '    gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +
69. '    gl_FrontColor = gl_Color;'#10 +
70. '    texCoord = gl_Vertex.xy / canvasSize;'#10 +
71. '}',
72.  
73. 'uniform float time;'#10 +
74. 'out vec4 FragmentColor;'#10 +
75. 'void main(void)'#10 +
76. '{'#10 +
77. ' vec2 pos = texCoord - vec2(0.5,0.5);     '#10 +
78. ' float horizon = 0.0;  '#10 +
79. ' float fov = 0.5;      '#10 +
80. ' float scaling = 0.4;  '#10 +
81. ' vec3 p = vec3(pos.x, fov, pos.y - horizon);'#10 +
82. ' vec2 s = vec2(p.x/p.z, p.y/p.z) * scaling; '#10 +
83. ' float f = 1.0;                             '#10 +
84. ' //checkboard                               '#10 +
85. ' 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 +
86. ' col *= p.z*p.z*5.0*(1.0 - abs(p.x));'#10 +
87.  
88. ' FragmentColor = vec4(col*gl_Color.xyz, 1.0); '#10 +
89.  
90. '}',
91.  
92. 'varying vec2 texCoord;', '130');
93.  
94.   FCanvasSize := UniformPointF['canvasSize'];
95.   FTime := UniformSingle['time'];      // float uniform
96.   Time := 0;
97. end;
98.  
99. function TBGLCheckerBoardShader.Render(AWidth, AHeight: integer): IBGLTexture;
100. var previousBuf,buf: TBGLCustomFrameBuffer;
101. begin
102.   previousBuf := Canvas.ActiveFrameBuffer;
103.   buf := Canvas.CreateFrameBuffer(AWidth, AHeight);
104.   Canvas.ActiveFrameBuffer := buf;
105.   Canvas.Fill(BGRAPixelTransparent);
106.   RenderOnCanvas;
107.   Canvas.ActiveFrameBuffer := previousBuf;
108.   result := buf.MakeTextureAndFree;
109. end;
110.  
111. procedure TBGLCheckerBoardShader.RenderOnCanvas;
112. var
113.   previousShader: TBGLCustomShader;
114. begin
115.   previousShader := Canvas.Lighting.ActiveShader;
116.   Canvas.Lighting.ActiveShader := self;
117.   CanvasSize := PointF(Canvas.Width, Canvas.Height);
118.   Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSYellow);
119.   Canvas.Lighting.ActiveShader := previousShader;
120. end;
121.  
122. procedure TBGLCheckerBoardShader.StartUse;
123. begin
124.   inherited StartUse;
125.   FCanvasSize.Update;
126.   FTime.Update;
127. end;
128.  
129. end.

[Gigatron]

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]

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   BGLVirtualScreen, BGRAOpenGL, BGRACheckerBoardGL, BGRABitmapTypes,GL,mmsystem;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGLVirtualScreen1: TBGLVirtualScreen;
17.     Timer1: TTimer;
18.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
19.       BGLContext: TBGLContext);
20.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
21.     procedure BGLVirtualScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);
22.     procedure FormCreate(Sender: TObject);
23.     procedure Timer1Timer(Sender: TObject);
24.   private
25.     gtr_logo  : IBGLTexture;
26.     logo_xpos : integer;
27.     checker: TBGLCheckerBoardShader;
28.     MainFont: IBGLFont;
29.     line_message :Array of PChar;
30.     LineXpos,   LineYpos, bounce,fct  : Single;
31.     // color select
32.     C_color : integer;
33.  
34.     // dot plot
35.     s,a,ag : single;
36.     alfa,alfa_time,plot_dir,p_x : integer;
37.   public
38.  
39.   MyAudio_File: AnsiString;
40.   WavStream : TMemoryStream;
41.  
42.   end;
43.  
44. var
45.   Form1: TForm1;
46.  
47. implementation
48.  
49. {$R *.lfm}
50.  
51. { TForm1 }
52.  
53. procedure TForm1.FormCreate(Sender: TObject);
54. begin
55.   MainFont := BGLFont('AmigaParadox',60);
56.  
57.   SetLength(line_message, 1);
58.   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 ........');
59.   LineXPos := 2800;
60.   LineYpos := 460;
61.   bounce := 0.0;
62.   fct    := 0.0;
63.   // plot fx
64.    s := 255/sqrt(3)*2/30;
65.    a := 0.0;
66.    p_x := -1400;
67.    // angle
68.    ag := 0.0;
69.    alfa :=0;
70.    // logo x pos
71.    logo_xpos:= -800;
72.    // checker color
73.    C_color :=0;
74.  
75.     // audio stream
76.     MyAudio_File := 'itspheno.wav';
77.     WavStream    := TMemoryStream.Create;
78.     WavStream.LoadFromFile(MyAudio_File);
79.     PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY);
80.  
81. end;
82.  
83. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
84. var
85.   i : integer;
86.   xx,yy : integer;
87.   r,z,x1,x2,y1,y2 : single;
88.  
89. begin
90.       checker.Time:= checker.Time +0.030;
91.       checker.Fcolor := C_color;
92.       checker.RenderOnCanvas;
93.       BGLContext.Canvas.PutImage(logo_xpos,0, gtr_logo,alfa);
94.  
95.  
96.   // plot fx
97.       for xx:=15 downto -15 do
98.        begin
99.          for yy:=15 downto -15 do
100.           begin
101.  
102.            r := (sqrt(xx*xx+yy*yy))+2;
103.            z := 40*sin(r+a*0.6)/r*0.8;
104.  
105.            x2 := xx*cos(a*PI/180)-yy*sin(ag*PI/180);
106.            y2 := xx*sin(a*PI/180)+yy*cos(ag*PI/180);
107.  
108.            x1 := round(360+(y2-x2)*s*sqrt(3)/2);
109.            y1 := round(300+z-(y2+x2)*s/2);
110.            BgLContext.Canvas.Arc(x1+p_x,y1,2,2,0,360,BGRA(alfa,alfa,alfa),false,BGRA(180,180,180));
111.  
112.           end;
113.        end;
114.  
115.        ag := ag - 0.1;
116.  
117.         for  i := 0 to  Length(line_message[0])-1 do
118.       begin
119.        if LinexPos < -Length(line_message[0]) * 30  then
120.        begin
121.        LinexPos := 800;
122.        end;
123.        LinexPos := LineXPos - 0.012;
124.        LineyPos := 460;
125.        MainFont.TextOut(i * 30  + LinexPos+4,LineYPos-50*abs(sin(bounce)*2)+2 , line_message[0][i],BGRA(255,255,255));
126.        MainFont.TextOut(i * 30  + LinexPos,LineYPos-50*abs(sin(bounce)*2) , line_message[0][i],BGRA(20,120,255));
127.       end;
128.        bounce := bounce + 0.04;
129.  
130.  
131.       if(plot_dir=1) then  a := a + 0.2;
132.       if(plot_dir=2) then  a := a - 0.2;
133.  
134. end;
135.  
136. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
137.   BGLContext: TBGLContext);
138. begin
139.  
140.   gtr_logo := BGLTexture(ResourceFile('phex.png'));
141.   checker := TBGLCheckerBoardShader.Create(BGLContext.Canvas);
142.  
143. end;
144.  
145. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
146.   BGLContext: TBGLContext);
147. begin
148.   gtr_logo   := nil;
149.   FreeAndNil(checker);
150. end;
151.  
152. procedure TForm1.Timer1Timer(Sender: TObject);
153. begin
154.       inc(alfa_time);
155.       if(alfa_time>300+Random(600)) then
156.       begin
157.         alfa_time :=0;
158.         plot_dir := 1+Random(2);
159.         C_color := C_color + 1;
160.         if(C_color>=4) then C_color:=0;
161.       end;
162.  
163.       inc(logo_xpos,5);
164.       if(logo_xpos>=30) then
165.       begin
166.       inc(alfa);
167.       if (alfa>=250) then alfa :=250;
168.       logo_xpos :=30;
169.       end;
170.  
171.       inc(p_x,20);
172.       if(p_x>=20) then p_x :=20;
173.  
174.       BGLVirtualScreen1.Repaint;
175. end;
176.  
177. end.
178.  

Checker_Board Unit ; thx to @circular for the latest simple and small code :

Code: Pascal  [Select][+][-]

1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
2.  
3. { Checkerboard effect using OpenGL shaders }
4. unit BGRACheckerBoardGL;
5.  
6. {$mode objfpc}{$H+}
7.  
8. interface
9.  
10. uses
11.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
12.  
13. type
14.   { Shader computing Checkerboard }
15.   TBGLCheckerBoardShader = class(TBGLShader3D)
16.   private
17.     function GetCanvasSize: TPointF;
18.     function GetTime: Single;
19.     procedure SetTime(AValue: Single);
20.     function  GetColor: Integer;
21.     procedure SetColor(AValue: Integer);
22.  
23.     procedure SetCanvasSize(AValue: TPointF);
24.  
25.  
26.   protected
27.  
28.     FCanvasSize: TUniformVariablePointF;
29.     FTime:       TUniformVariableSingle;
30.     Fcol :       Integer;
31.     procedure StartUse; override;
32.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
33.  
34.   public
35.     constructor Create(ACanvas: TBGLCustomCanvas);
36.     function Render(AWidth, AHeight: integer): IBGLTexture; overload;
37.     procedure RenderOnCanvas;
38.     property Time: Single read GetTime write SetTime;
39.     property Fcolor: Integer read GetColor write SetColor;
40.  
41.   end;
42.  
43. implementation
44.  
45. { TBGLCheckerBoardShader }
46.  
47. function TBGLCheckerBoardShader.GetCanvasSize: TPointF;
48. begin
49.   result := FCanvasSize.Value;
50. end;
51.  
52. function TBGLCheckerBoardShader.GetTime: Single;
53. begin
54.   result := FTime.Value;
55. end;
56.  
57. procedure TBGLCheckerBoardShader.SetCanvasSize(AValue: TPointF);
58. begin
59.   FCanvasSize.Value := AValue;
60. end;
61.  
62. procedure TBGLCheckerBoardShader.SetTime(AValue: Single);
63. begin
64.     FTime.Value := AValue;
65. end;
66.  
67. function TBGLCheckerBoardShader.GetColor: Integer;
68. begin
69.   result := FCol;
70. end;
71.  
72. procedure TBGLCheckerBoardShader.SetColor(AValue: Integer);
73. begin
74.     FCol := AValue;
75. end;
76.  
77. constructor TBGLCheckerBoardShader.Create(ACanvas: TBGLCustomCanvas);
78.  
79. begin
80. // vertex + fragment
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. '}',
88.  
89. 'uniform float time;'#10 +
90. 'out vec4 FragmentColor;'#10 +
91. 'void main(void)'#10 +
92. '{'#10 +
93. ' vec2 pos = texCoord - vec2(0.5,0.5);     '#10 +
94. ' float horizon = 0.0;  '#10 +
95. ' float fov = 0.5;      '#10 +
96. ' float scaling = 0.4;  '#10 +
97. ' vec3 p = vec3(pos.x, fov, pos.y - horizon);'#10 +
98. ' vec2 s = vec2(p.x/p.z, p.y/p.z) * scaling; '#10 +
99. ' float f = 1.0;                             '#10 +
100. ' //checkboard                               '#10 +
101. ' 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 +
102. ' col *= p.z*p.z*5.0*(1.0 - abs(p.x));'#10 +
103.  
104. ' FragmentColor = vec4(col*gl_Color.xyz, 1.0); '#10 +
105.  
106. '}',
107.  
108. 'varying vec2 texCoord;', '130');
109.  
110.   FCanvasSize := UniformPointF['canvasSize'];
111.   FTime := UniformSingle['time'];      // float uniform
112.  
113.   Fcol :=1;
114.   Time := 0;
115. end;
116.  
117. function TBGLCheckerBoardShader.Render(AWidth, AHeight: integer): IBGLTexture;
118. var previousBuf,buf: TBGLCustomFrameBuffer;
119. begin
120.   previousBuf := Canvas.ActiveFrameBuffer;
121.   buf := Canvas.CreateFrameBuffer(AWidth, AHeight);
122.   Canvas.ActiveFrameBuffer := buf;
123.   Canvas.Fill(BGRAPixelTransparent);
124.   RenderOnCanvas;
125.   Canvas.ActiveFrameBuffer := previousBuf;
126.   result := buf.MakeTextureAndFree;
127. end;
128.  
129. procedure TBGLCheckerBoardShader.RenderOnCanvas;
130. var
131.   previousShader: TBGLCustomShader;
132. begin
133.   previousShader := Canvas.Lighting.ActiveShader;
134.   Canvas.Lighting.ActiveShader := self;
135.   CanvasSize := PointF(Canvas.Width, Canvas.Height);
136.  
137.   Case   FCol of
138.   0: Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSRed);
139.   1: Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSYellow);
140.   2: Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSBlue);
141.   3: Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSCyan);
142.   else
143.    Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSRed);
144.   end;
145.  
146.  
147.   Canvas.Lighting.ActiveShader := previousShader;
148. end;
149.  
150. procedure TBGLCheckerBoardShader.StartUse;
151. begin
152.   inherited StartUse;
153.   FCanvasSize.Update;
154.   FTime.Update;
155. end;
156.  
157. end.

[circular]

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]

Sure , all files are included except .exe on my ftp network ;


http://gigatron3k.free.fr/laz/Bgra_Gl_Shader0.zip

Best Regards

[circular]

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]

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.

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_Shader0.zip

[circular]

Thank you very much Lainz 

[Gigatron]

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.

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.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   BGLVirtualScreen, BGRAOpenGL,BGRASeascapeShader,BGRABitmapTypes,GL;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGLVirtualScreen1: TBGLVirtualScreen;
17.     Timer1: TTimer;
18.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
19.       BGLContext: TBGLContext);
20.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
21.     procedure FormCreate(Sender: TObject);
22.     procedure Timer1Timer(Sender: TObject);
23.   private
24.   seascape: TBGLSeascapeShader;
25.   public
26.  
27.   end;
28.  
29. var
30.   Form1: TForm1;
31.  
32. implementation
33.  
34. {$R *.lfm}
35.  
36. { TForm1 }
37.  
38. procedure TForm1.FormCreate(Sender: TObject);
39. begin
40.  
41. end;
42.  
43. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);
44.  
45. begin
46.       seascape.Time:= seascape.Time +0.004;
47.       seascape.RenderOnCanvas;
48. end;
49.  
50. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
51.   BGLContext: TBGLContext);
52. begin
53.  
54.   seascape := TBGLSeascapeShader.Create(BGLContext.Canvas);
55. end;
56.  
57. procedure TForm1.Timer1Timer(Sender: TObject);
58. begin
59.       BGLVirtualScreen1.Repaint;
60. end;
61.  
62. end.
63.  

[Gigatron]

Code: Pascal  [Select][+][-]

1.  
2. [code=pascal]// SPDX-License-Identifier: LGPL-3.0-linking-exception
3.  
4. { Checkerboard effect using OpenGL shaders }
5. unit BGRASeascapeShader;
6.  
7. {$mode objfpc}{$H+}
8.  
9. interface
10.  
11. uses
12.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
13.  
14. type
15.   { Shader computing Checkerboard }
16.   TBGLSeascapeShader = class(TBGLShader3D)
17.   private
18.     function GetCanvasSize: TPointF;
19.     procedure SetCanvasSize(AValue: TPointF);
20.     function GetImageIndex: integer;
21.     function GetTime: Single;
22.     procedure SetImageIndex(AValue: integer);
23.     procedure SetTime(AValue: Single);
24.  
25.   protected
26.     FCanvasSize: TUniformVariablePointF;
27.     FImageIndex: TUniformVariableInteger;
28.     FTime:     TUniformVariableSingle;
29.     procedure StartUse; override;
30.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
31.  
32.   public
33.     constructor Create(ACanvas: TBGLCustomCanvas);
34.     function Render(AWidth, AHeight: integer): IBGLTexture; overload;
35.     procedure RenderOnCanvas;
36.     property ImageIndex: integer read GetImageIndex write SetImageIndex;
37.     property Time: Single read GetTime write SetTime;
38.  
39.   end;
40.  
41. implementation
42.  
43. { TBGLSeascapeShader }
44.  
45. function TBGLSeascapeShader.GetCanvasSize: TPointF;
46. begin
47.   result := FCanvasSize.Value;
48. end;
49.  
50. function TBGLSeascapeShader.GetTime: Single;
51. begin
52.   result := FTime.Value;
53. end;
54.  
55. procedure TBGLSeascapeShader.SetCanvasSize(AValue: TPointF);
56. begin
57.   FCanvasSize.Value := AValue;
58. end;
59.  
60. function TBGLSeascapeShader.GetImageIndex: integer;
61. begin
62.   result := FImageIndex.Value;
63. end;
64.  
65.  
66. procedure TBGLSeascapeShader.SetImageIndex(AValue: integer);
67. begin
68.   FImageIndex.Value := AValue;
69. end;
70.  
71. procedure TBGLSeascapeShader.SetTime(AValue: Single);
72. begin
73.     FTime.Value := AValue;
74. end;
75.  
76.  
77. constructor TBGLSeascapeShader.Create(ACanvas: TBGLCustomCanvas);
78.  
79. begin
80. // vertex + fragment
81. inherited Create(ACanvas,
82. 'uniform vec2 canvasSize;'#10+
83. 'void main(void) {'#10 +
84. '       gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +
85. '    //texCoord = vec2(gl_MultiTexCoord0);'#10 +
86. '    texCoord = gl_Vertex.xy / canvasSize;;'#10 +
87. '}',
88.  
89. 'uniform float time;'#10 +
90. 'uniform sampler2D image;'#10 +
91. 'out vec4 FragmentColor;'#10 +
92.  
93. '/*                                                                                      '#10+
94. ' * "Seascape" by Alexander Alekseev aka TDM - 2014                                      '#10+
95. ' * License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License.  '#10+
96. ' * Contact: tdmaav@gmail.com                                                            '#10+
97. ' */                                                                                     '#10+
98. '                                                                                        '#10+
99. 'const int NUM_STEPS = 16;                                                               '#10+
100. 'const float PI         = 3.141592;                                                      '#10+
101. 'const float EPSILON    = 1e-3;                                                          '#10+
102.  
103. '//#define AA                                                                            '#10+
104. '                                                                                        '#10+
105. '// sea                                                                                  '#10+
106. 'const int ITER_GEOMETRY = 3;                                                            '#10+
107. 'const int ITER_FRAGMENT = 5;                                                            '#10+
108. 'const float SEA_HEIGHT = 0.6;                                                           '#10+
109. 'const float SEA_CHOPPY = 4.0;                                                           '#10+
110. 'const float SEA_SPEED = 3.0;                                                            '#10+
111. 'const float SEA_FREQ = 0.16;                                                            '#10+
112. 'const vec3 SEA_BASE = vec3(0.0,0.09,0.18);                                              '#10+
113. 'const vec3 SEA_WATER_COLOR = vec3(0.8,0.9,0.6)*0.8;                                     '#10+
114. '#define SEA_TIME (1.0 + time * SEA_SPEED)                                               '#10+
115. 'const mat2 octave_m = mat2(1.6,1.2,-1.2,1.6);                                           '#10+
116. '//                                                                                      '#10+
117. '                                                                                        '#10+
118. '                                                                                        '#10+
119. '// math                                                                                 '#10+
120. 'mat3 fromEuler(vec3 ang) {                                                              '#10+
121. '       vec2 a1 = vec2(sin(ang.x),cos(ang.x));                                           '#10+
122. '    vec2 a2 = vec2(sin(ang.y),cos(ang.y));                                              '#10+
123. '    vec2 a3 = vec2(sin(ang.z),cos(ang.z));                                              '#10+
124. '    mat3 m;                                                                             '#10+
125. '    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+
126. '       m[1] = vec3(-a2.y*a1.x,a1.y*a2.y,a2.x);                                          '#10+
127. '       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+
128. '       return m;                                                                        '#10+
129. '}'#10+
130. 'float hash( vec2 p ) {                                                                  '#10+
131. '       float h = dot(p,vec2(127.1,311.7));                                              '#10+
132. '    return fract(sin(h)*43758.5453123);                                                 '#10+
133. '}'#10+
134. 'float noise( in vec2 p ) {                                                              '#10+
135. '    vec2 i = floor( p );                                                                '#10+
136. '    vec2 f = fract( p );                                                                '#10+
137. '       vec2 u = f*f*(3.0-2.0*f);                                                        '#10+
138. '    return -1.0+2.0*mix( mix( hash( i + vec2(0.0,0.0) ),                                '#10+
139. '                     hash( i + vec2(1.0,0.0) ), u.x),                                   '#10+
140. '                mix( hash( i + vec2(0.0,1.0) ),                                         '#10+
141. '                     hash( i + vec2(1.0,1.0) ), u.x), u.y);                             '#10+
142. '}'#10+
143. '                                                                                        '#10+
144. '// lighting                                                                             '#10+
145. 'float diffuse(vec3 n,vec3 l,float p) {                                                  '#10+
146. '    return pow(dot(n,l) * 0.4 + 0.6,p);                                                 '#10+
147. '}'#10+
148. 'float specular(vec3 n,vec3 l,vec3 e,float s) {                                          '#10+
149. '    float nrm = (s + 8.0) / (PI * 8.0);                                                 '#10+
150. '    return pow(max(dot(reflect(e,n),l),0.0),s) * nrm;                                   '#10+
151. '}'#10+
152. '                                                                                        '#10+
153. '// sky                                                                                  '#10+
154. 'vec3 getSkyColor(vec3 e) {                                                              '#10+
155. '    e.y = (max(e.y,0.0)*0.8+0.2)*0.8;                                                   '#10+
156. '    return vec3(pow(1.0-e.y,2.0), 1.0-e.y, 0.6+(1.0-e.y)*0.4) * 1.1;                    '#10+
157. '}'#10+
158. '                                                                                        '#10+
159. '// sea                                                                                  '#10+
160. 'float sea_octave(vec2 uv, float choppy) {                                               '#10+
161. '    uv += noise(uv);                                                                    '#10+
162. '    vec2 wv = 1.0-abs(sin(uv));                                                         '#10+
163. '    vec2 swv = abs(cos(uv));                                                            '#10+
164. '    wv = mix(wv,swv,wv);                                                                '#10+
165. '    return pow(1.0-pow(wv.x * wv.y,0.65),choppy);                                       '#10+
166. '}'#10+
167. '                                                                                        '#10+
168. 'float map(vec3 p) {                                                                     '#10+
169. '    float freq = SEA_FREQ;                                                              '#10+
170. '    float amp = SEA_HEIGHT;                                                             '#10+
171. '    float choppy = SEA_CHOPPY;                                                          '#10+
172. '    vec2 uv = p.xz; uv.x *= 0.75;                                                       '#10+
173. '                                                                                        '#10+
174. '    float d, h = 0.0;                                                                   '#10+
175. '    for(int i = 0; i < ITER_GEOMETRY; i++) {                                            '#10+
176. '       d = sea_octave((uv+SEA_TIME)*freq,choppy);                                       '#10+
177. '       d += sea_octave((uv-SEA_TIME)*freq,choppy);                                      '#10+
178. '        h += d * amp;                                                                   '#10+
179. '       uv *= octave_m; freq *= 1.9; amp *= 0.22;                                        '#10+
180. '        choppy = mix(choppy,1.0,0.2);                                                   '#10+
181. '    }                                                                                   '#10+
182. '    return p.y - h;                                                                     '#10+
183. '}'#10+
184. '                                                                                        '#10+
185. 'float map_detailed(vec3 p) {                                                            '#10+
186. '    float freq = SEA_FREQ;                                                              '#10+
187. '    float amp = SEA_HEIGHT;                                                             '#10+
188. '    float choppy = SEA_CHOPPY;                                                          '#10+
189. '    vec2 uv = p.xz; uv.x *= 0.75;                                                       '#10+
190. '                                                                                        '#10+
191. '    float d, h = 0.0;                                                                   '#10+
192. '    for(int i = 0; i < ITER_FRAGMENT; i++) {                                            '#10+
193. '       d = sea_octave((uv+SEA_TIME)*freq,choppy);                                       '#10+
194. '       d += sea_octave((uv-SEA_TIME)*freq,choppy);                                      '#10+
195. '        h += d * amp;                                                                   '#10+
196. '       uv *= octave_m; freq *= 1.9; amp *= 0.22;                                        '#10+
197. '        choppy = mix(choppy,1.0,0.2);                                                   '#10+
198. '    }                                                                                   '#10+
199. '    return p.y - h;                                                                     '#10+
200. '}'#10+
201. '                                                                                        '#10+
202. 'vec3 getSeaColor(vec3 p, vec3 n, vec3 l, vec3 eye, vec3 dist) {                         '#10+
203. '    float fresnel = clamp(1.0 - dot(n,-eye), 0.0, 1.0);                                 '#10+
204. '    fresnel = min(pow(fresnel,3.0), 0.5);                                               '#10+
205. '                                                                                        '#10+
206. '    vec3 reflected = getSkyColor(reflect(eye,n));                                       '#10+
207. '    vec3 refracted = SEA_BASE + diffuse(n,l,80.0) * SEA_WATER_COLOR * 0.12;             '#10+
208. '                                                                                        '#10+
209. '    vec3 color = mix(refracted,reflected,fresnel);                                      '#10+
210. '                                                                                        '#10+
211. '    float atten = max(1.0 - dot(dist,dist) * 0.001, 0.0);                               '#10+
212. '    color += SEA_WATER_COLOR * (p.y - SEA_HEIGHT) * 0.18 * atten;                       '#10+
213. '                                                                                        '#10+
214. '    color += vec3(specular(n,l,eye,60.0));                                              '#10+
215. '                                                                                        '#10+
216. '    return color;                                                                       '#10+
217. '}'#10+
218. '                                                                                        '#10+
219. '// tracing                                                                              '#10+
220. 'vec3 getNormal(vec3 p, float eps) {                                                     '#10+
221. '    vec3 n;                                                                             '#10+
222. '    n.y = map_detailed(p);                                                              '#10+
223. '    n.x = map_detailed(vec3(p.x+eps,p.y,p.z)) - n.y;                                    '#10+
224. '    n.z = map_detailed(vec3(p.x,p.y,p.z+eps)) - n.y;                                    '#10+
225. '    n.y = eps;                                                                          '#10+
226. '    return normalize(n);                                                                '#10+
227. '}'#10+
228. '                                                                                        '#10+
229. 'float heightMapTracing(vec3 ori, vec3 dir, out vec3 p) {                                '#10+
230. '    float tm = 0.0;                                                                     '#10+
231. '    float tx = 1000.0;                                                                  '#10+
232. '    float hx = map(ori + dir * tx);                                                     '#10+
233. '    if(hx > 0.0) {                                                                      '#10+
234. '        p = ori + dir * tx;                                                             '#10+
235. '        return tx;                                                                      '#10+
236. '    }                                                                                   '#10+
237. '    float hm = map(ori + dir * tm);                                                     '#10+
238. '    float tmid = 0.0;                                                                   '#10+
239. '    for(int i = 0; i < NUM_STEPS; i++) {                                                '#10+
240. '        tmid = mix(tm,tx, hm/(hm-hx));                                                  '#10+
241. '        p = ori + dir * tmid;                                                           '#10+
242. '       float hmid = map(p);                                                             '#10+
243. '               if(hmid < 0.0) {                                                         '#10+
244. '               tx = tmid;                                                               '#10+
245. '            hx = hmid;                                                                  '#10+
246. '        } else {                                                                        '#10+
247. '            tm = tmid;                                                                  '#10+
248. '            hm = hmid;                                                                  '#10+
249. '        }                                                                               '#10+
250. '    }                                                                                   '#10+
251. '    return tmid;                                                                        '#10+
252. '}'#10+
253.  
254.  
255. // main
256. 'void main(void)'#10 +
257. '{'#10 +
258. '                                                                                                    '#10+
259. '                                                                                                    '#10+
260. '       vec2 uv = texCoord *2.-1.0;                                                             '#10+
261. '            uv.y =1.-uv.y;'#10+
262. '    // ray                                                                                          '#10+
263. '    vec3 ang = vec3(sin(time*3.0)*0.1,sin(time)*0.2+0.8,time);                                   '#10+
264. '    vec3 ori = vec3(0.0,3.5,time*5.0);                                                       '#10+
265. '    vec3 dir = normalize(vec3(uv.xy,-2.0));                                                            '#10+
266. '    dir = normalize(dir) * fromEuler(ang);                                                          '#10+
267. '                                                                                                    '#10+
268. '    // tracing                                                                                      '#10+
269. '    vec3 p;                                                                                         '#10+
270. '    heightMapTracing(ori,dir,p);                                                                    '#10+
271. '    vec3 dist = p - ori;                                                                            '#10+
272. '    vec3 n = getNormal(p, dot(dist,dist) * 0.0001);                                            '#10+
273. '    vec3 light = normalize(vec3(0.0,1.0,0.8));                                                      '#10+
274.  
275. '        vec3 color = mix(                                                                           '#10+
276. '    getSkyColor(dir), getSeaColor(p, n, light, dir, dist), pow(smoothstep(0.0, -0.05, dir.y), 0.3));'#10+
277. '                                                                                                    '#10+
278. '                                                                                                    '#10+
279. ' FragmentColor =   vec4(pow(color, vec3(0.75)), 1.0); '#10 +
280.  
281. '}',
282.  
283. 'varying vec2 texCoord;', '130');
284.  
285.    FCanvasSize := UniformPointF['canvasSize'];
286.  //  FImageIndex := UniformInteger['image'];
287.   FTime := UniformSingle['time'];      // float uniform
288.   ImageIndex:= 0;
289.   Time := 0;
290. end;
291.  
292. function TBGLSeascapeShader.Render(AWidth, AHeight: integer): IBGLTexture;
293. var previousBuf,buf: TBGLCustomFrameBuffer;
294. begin
295.   previousBuf := Canvas.ActiveFrameBuffer;
296.   buf := Canvas.CreateFrameBuffer(AWidth, AHeight);
297.   Canvas.ActiveFrameBuffer := buf;
298.   Canvas.Fill(BGRAPixelTransparent);
299.   RenderOnCanvas;
300.   Canvas.ActiveFrameBuffer := previousBuf;
301.   result := buf.MakeTextureAndFree;
302. end;
303. procedure TBGLSeascapeShader.RenderOnCanvas;
304. var
305.   previousShader: TBGLCustomShader;
306. begin
307.   previousShader := Canvas.Lighting.ActiveShader;
308.   Canvas.Lighting.ActiveShader := self;
309.   CanvasSize := PointF(Canvas.Width, Canvas.Height);
310.   Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, CSSYellow);
311.   Canvas.Lighting.ActiveShader := previousShader;
312. end;
313.  
314.  
315. procedure TBGLSeascapeShader.StartUse;
316. begin
317.   inherited StartUse;
318.   FCanvasSize.Update;
319. //  FImageIndex.Update;
320.   FTime.Update;
321. end;
322.  
323. end.

[/code]

[circular]

Wow this is incredible. Just with a shader. I am out of words 

[lainz]

It's like chinese for me