Demo Scene BGRA GL Shader

[Gigatron]

Oh my duckling! This is a full demo we have here.

Love this song! Second Reality is one of the first top demo I've seen.

It proves that with the BGRA component you can do a nice demo like all computer and console systems from Atari-600 to PSX1

@circular you did a very good job, thank you very much;

[circular]

It is heartwarming to see my library help making nice demos.

It is also comforting, as OpenGL support has been kind of an experiment for me. Now that we have fixed a few things, I will publish a new version of BGRABitmap.

 

[Gigatron]

@circular I follow BGRA closely by including the shaders you did an excellent job.
 I continue to make demos when I have time The Pascal language is the simplest programming language,
 maybe java and javascript too !!!

[hcoenen]

I cannot believe it. after years lurking these forums.... but i finally registered just to react to this thread.

Absolutely love to see that the demoscene is still alive and lazarus seems to be part of it :-) brings a bit of joy to a depressed heart.
Good memories that never really went away. I hope to dive into bgra sometime to understand some of it.

I did glance  over some code and noticed the sound part, these are wave files. i vaguely remember most demos in the time used mod / xm / s3m format etc.
the last component i dabbled with was made by benjamin rousseaux (beroxm which was win32 only) and produced much smaller (and with less quality, but hey chip tunes... so who cares?) files

does anyone know if anything like that is available for lazarus nowadays?

[TRon]

does anyone know if anything like that is available for lazarus nowadays?

afaik BeroXM is still active.

There exist tralala from user nickysn and there are individual (other) mod format players available for pascal as well.

[Gigatron]

I cannot believe it. after years lurking these forums.... but i finally registered just to react to this thread.

Absolutely love to see that the demoscene is still alive and lazarus seems to be part of it :-) brings a bit of joy to a depressed heart.
Good memories that never really went away. I hope to dive into bgra sometime to understand some of it.

I did glance  over some code and noticed the sound part, these are wave files. i vaguely remember most demos in the time used mod / xm / s3m format etc.
the last component i dabbled with was made by benjamin rousseaux (beroxm which was win32 only) and produced much smaller (and with less quality, but hey chip tunes... so who cares?) files

does anyone know if anything like that is available for lazarus nowadays?

Hi, i ve just tested Fastracker module playing with lazarus fpc. (cerror.xm) playing like a charm
What you need are the Raylib.dll + raylib.pas unit from Guvacode + BGRA component .

Here is the example of code and live video on YT: Better colors, better code ;

 https://www.youtube.com/watch?v=6o7cJ9ApGCQ

 

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   Buttons, BGLVirtualScreen, BGRAOpenGL, BGRACMapShader, BGRABitmapTypes,RayLib; // raylib unit
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGLVirtualScreen1: TBGLVirtualScreen;
17.  
18.     Timer1: TTimer;
19.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
20.       BGLContext: TBGLContext);
21.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
22.     procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;
23.       BGLContext: TBGLContext);
24.     procedure FormCreate(Sender: TObject);
25.     procedure FormDestroy(Sender: TObject);
26.     procedure Timer1Timer(Sender: TObject);
27.   private
28.     cmap_shader: TBGLCMapShader;
29.  
30.   public
31.    texture,gl_surface,phenix : IBGLTexture;
32.    fnt,fntw : IBGLFont;
33.    rdtimer,xpos,ypos,alfa,rdtx : integer;
34.    txt : String;
35.   end;
36.  
37. var
38.   Form1: TForm1;
39.   music:TMusic;
40.  
41. implementation
42.  
43. {$R *.lfm}
44.  
45. { TForm1 }
46.  
47. procedure TForm1.FormCreate(Sender: TObject);
48. begin
49.    fnt := BGLFont('Amstrad CPC464',60);
50.    fntw := BGLFont('Amstrad CPC464',58);
51.    xpos:= 0;
52.    ypos:=1000;
53.    rdtimer :=0;
54.    alfa :=0;
55.    txt := ' HELLO , GIGATRON PRESENTS BGRA GL SHADER EXAMPLE WITH RAYLIB FASTTRACKER XM MODULE PLAYER SFX BY: CYBERNAUT / CHAOS THANKS TO ALL MEMBERS OF MEGA-FACTORY LLC, CIRCULAR FOR THE BEST COMPONENT BGRA , GUVACODE FOR RAYLAZ, AND LAZARUS FPC TEAM AND MEMBERS SEE YOU ....';
56.  
57.  // Initialization audio + load module
58.   InitAudioDevice();
59.   music := LoadMusicStream(PChar(GetApplicationDirectory + 'mods/freemind3.xm'));    // xm module
60.   music.looping := false;
61.   PlayMusicStream(music);
62. end;
63.  
64. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
65. begin
66.     gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
67.     texture     := BGLTexture(ResourceFile('girl5.png'));
68.     phenix    := BGLTexture(ResourceFile('phex.png'));
69.     cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);
70. end;
71.  
72. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
73. begin
74.     // le traitement du sampler2D comme texture
75.      cmap_shader.ImageIndex:= 0;
76.      gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader
77.      cmap_shader.Render(texture);
78.      BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image de miss marvel
79.      fnt.TextOut(800-xpos,520,txt,BGRA(80,80,80,rdtx));
80.      BGLContext.Canvas.PutImage(60,ypos,phenix,BGRA(255,255,255,alfa));
81.      Upda]"]>BlockedsicStream(music);       // Update music buffer with new stream data only here !!
82.  
83. end;
84.  
85. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
86.   BGLContext: TBGLContext);
87. begin
88.   // libere et vire tout !!
89.   texture    := nil;
90.   gl_surface := nil;
91.   FreeAndNil(cmap_shader);
92. end;
93.  
94. procedure TForm1.FormDestroy(Sender: TObject);
95. begin
96.  // De-Initialization
97.  UnloadMusicStream(music);  // Unload music stream buffers from RAM
98.  CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)
99. end;
100.  
101. procedure TForm1.Timer1Timer(Sender: TObject);
102. begin
103.     inc(rdtimer);
104.   if (rdtimer >= 10) then
105.     begin
106.       rdtimer :=0;
107.       inc(alfa);
108.       rdtx:= 50+Random(200);
109.       if(alfa>=255) then alfa:=255;
110.     end;
111.    cmap_shader.Time   := cmap_shader.Time+ 0.006;
112.    inc(xpos,2);
113.    if(xpos>16800) then xpos :=0;
114.    if(ypos>0) then dec(ypos) else ypos:=0;
115.  
116.    BGLVirtualScreen1.Invalidate;
117. end;
118.  
119. end.
120.  
121.  

Conclusion you can play xm module with BGRA component + glsl shader etc ! Not tested .s3m or .mod format ;

** Edit : original mod format is working mean protracker module, not saved with openmpt tracker;
   Screamtracker module .s3m not working ? don't know why yet ??


Feel free to contact me if you want simple example  ;

Regards Gigatron

[lainz]

Hi can you please try making this video effect?
https://music.youtube.com/watch?v=kDrjY2F5JUI&si=xuQCHLpFc3OFBKg8

[Gigatron]

Hi

It reminds me of an old shader based on the kaleidoscope, I'll look in my shader archives... so be patient

Quick made demo for testing the result based on an old shader ;

 Video example here :

https://www.youtube.com/watch?v=sEAVEZdV7X0

**** Hope you like it ; There is a problem between the original shader ; My mistake, the texture must be power of 2 size , sorry !!!

Main unit:

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   Buttons, Spin, BGLVirtualScreen, BGRAOpenGL, BGRAKaleidoscopeShader,
10.   BGRATextFX, BGRAGradients, BGRAFontGL, BGRABitmapTypes, RayLib; // raylib unit
11.  
12. type
13.  
14.   { TForm1 }
15.  
16.   TForm1 = class(TForm)
17.     BGLVirtualScreen1: TBGLVirtualScreen;
18.     FloatSpinEdit1: TFloatSpinEdit;
19.     Timer1: TTimer;
20.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
21.       BGLContext: TBGLContext);
22.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
23.     procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;
24.       BGLContext: TBGLContext);
25.     procedure FormCreate(Sender: TObject);
26.     procedure FormDestroy(Sender: TObject);
27.     procedure Timer1Timer(Sender: TObject);
28.   private
29.      k_shader: TBGLKaleidoscopeShader;
30.  
31.   public
32.    texture,gl_surface : IBGLTexture;
33.   end;
34.  
35. var
36.   Form1: TForm1;
37.   music:TMusic;
38.   master_vol : single;
39.  
40. implementation
41.  
42. {$R *.lfm}
43.  
44. { TForm1 }
45.  
46. procedure TForm1.FormCreate(Sender: TObject);
47. begin
48.     // Initialization audio + load module
49.   InitAudioDevice();
50.   music := LoadMusicStream(PChar(GetApplicationDirectory + 'mental_delivrance.xm'));    // xm module
51.   master_vol := 0;
52.   music.looping := true;
53.   PlayMusicStream(music);
54. end;
55.  
56. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
57.   BGLContext: TBGLContext);
58. begin
59.      // le traitement du sampler2D comme texture
60.      k_shader.ImageIndex:= 0;
61.      gl_surface :=k_shader.Render(texture);   // container de l'image affichee par le shader
62.      //k_shader.Render(texture);
63.      BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image de miss marvel
64.  
65.      SetMasterVolume(master_vol);
66.      if( master_vol<1.0) then master_vol := master_vol + 0.002;
67.      Upda]"]>BlockedsicStream(music);       // Update music buffer with new stream data only here !!
68. end;
69.  
70. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
71.   BGLContext: TBGLContext);
72. begin
73.     gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
74.     texture     := BGLTexture(ResourceFile('galaxy.jpg'));
75.     k_shader := TBGLKaleidoscopeShader.Create(BGLContext.Canvas);
76. end;
77.  
78. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
79.   BGLContext: TBGLContext);
80. begin
81.    texture    := nil;
82.    gl_surface := nil;
83.  
84.   FreeAndNil(k_shader);
85. end;
86.  
87. procedure TForm1.FormDestroy(Sender: TObject);
88. begin
89.    // De-Initialization
90.  UnloadMusicStream(music);  // Unload music stream buffers from RAM
91.  CloseAudioDevice();       // Close audio device (music streaming is automatically stopped)
92. end;
93.  
94. procedure TForm1.Timer1Timer(Sender: TObject);
95. begin
96.      k_shader.Time   := k_shader.Time+ 0.04;
97.      k_shader.Factor  := FloatSpinEdit1.Value;
98.      BGLVirtualScreen1.Invalidate;
99. end;
100.  
101. end.
102.  

Source kaleidoscope shader unit:

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

1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
2.  
3. { Hue X/Y Shift OpenGL shader }
4. unit BGRAKaleidoscopeShader;
5.  
6. {$mode objfpc}{$H+}
7.  
8. interface
9.  
10. uses
11.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
12.  
13. type
14.   { Hue X/Y Shift Shader computing shader  }
15.   TBGLKaleidoscopeShader = class(TBGLShader3D)
16.  
17.   private
18.  
19.   function GetCanvasSize: TPointF;
20.   procedure SetCanvasSize(AValue: TPointF);
21.  
22.   protected
23.     FTime: TUniformVariableSingle;
24.     FTimer : Single;
25.  
26.     FFact: TUniformVariableSingle;
27.     FFactV : Single;
28.  
29.     FImageIndex: TUniformVariableInteger;
30.     FImage_idx : Integer;
31.  
32.     FCanvasSize: TUniformVariablePointF;
33.     procedure StartUse; override;
34.  
35.   public
36.  
37.     constructor Create(ACanvas: TBGLCustomCanvas);
38.     function Render(ATexture: IBGLTexture): IBGLTexture; overload;
39.      procedure RenderOnCanvas;
40.     // propriete  ecriture des uniforms
41.     property Time: Single read FTimer write FTimer;
42.     property Factor: Single read FFactV write FFactV;
43.  
44.     property ImageIndex: integer read FImage_idx write FImage_idx;
45.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
46.  
47.   end;
48.  
49. implementation
50.  
51. function TBGLKaleidoscopeShader.GetCanvasSize: TPointF;
52. begin
53.   result := FCanvasSize.Value;
54. end;
55.  
56. procedure TBGLKaleidoscopeShader.SetCanvasSize(AValue: TPointF);
57. begin
58.   FCanvasSize.Value := AValue;
59. end;
60.  
61.  
62. { TBGLKaleidoscopeShader }
63.  
64. constructor TBGLKaleidoscopeShader.Create(ACanvas: TBGLCustomCanvas);
65.  
66. begin
67. // vertex + fragment
68. inherited Create(ACanvas,
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.  
77. 'out vec4 FragmentColor;'#10 +
78. 'uniform float time;'#10+
79. 'uniform float fct;'#10+
80. 'uniform sampler2D image;'#10+
81.  
82. 'vec2 kaleidoscope(vec2 uv)                               '#10+
83. '{                                                        '#10+
84. '       float th = atan(uv.y, uv.x);                          '#10+
85. '       float r = pow(length(uv), .9);                        '#10+
86. '       float f = 3.14159 / 6.5;                              '#10+
87. '       th = abs(mod(th + f/4.0, f) - f/2.0) / (1.0 + r);     '#10+
88. '       return vec2(cos(th), sin(th)) * r * .1;               '#10+
89. '}                                                        '#10+
90. '                                                         '#10+
91. 'vec2 transform(vec2 at)                                  '#10+
92. '{                                                        '#10+
93. '       vec2 v = vec2(0.0,0.0);                               '#10+
94. '       float th = .02 * time;                               '#10+
95. '       v.x = at.x * cos(th) - at.y * sin(th) - .2 * sin(th); '#10+
96. '       v.y = at.x * sin(th) + at.y * cos(th) + .2 * cos(th); '#10+
97. '       return v;                                             '#10+
98. '}                                                        '#10+
99.  
100.  
101. 'void main()'#10 +
102. '{'#10 +
103. 'vec2 uv =  texCoord.xy  ;                                   '#10+
104. // flip y
105. '   uv.y = 1.-uv.y;                                           '#10+
106. // resolution down
107. '//   uv = floor(128.0*uv)/128.0;'#10+
108. // move texture xy position in uv
109. ' vec2  xy = vec2(0.40,0.70);'#10+
110.  
111. '  gl_FragColor = texture2D(image, transform(kaleidoscope(uv-xy))*fct); '#10+
112. ' // gl_FragColor = texture2D(image, uv-xy); '#10+    // debug image
113.  
114. // fin
115.  
116. '}',
117. 'varying vec2 texCoord;', '130');
118.  
119.   FTime := UniformSingle['time'];      // float uniform
120.   FFact := UniformSingle['fct']; ;
121.  
122.   FImageIndex := UniformInteger['image'];
123.   FCanvasSize := UniformPointF['canvasSize'];
124.   FImage_idx:= 0;
125.   FTimer := 0;
126.   FFactV := 0.0;
127. end;
128.  
129. procedure TBGLKaleidoscopeShader.StartUse;
130. begin
131.   inherited StartUse;
132.   FTime.Update;
133.   FTime.Value:=FTimer;
134.   FImageIndex.Update;
135.   // set values to uniforms
136.  
137.   FFact.Update;
138.   FFact.Value:= FFactV;
139.  // FCanvasSize.Update;
140.  
141. end;
142.  
143. function TBGLKaleidoscopeShader.Render(ATexture: IBGLTexture): IBGLTexture;
144. var previousBuf,buf: TBGLCustomFrameBuffer;
145.   previousShader: TBGLCustomShader;
146. begin
147.   previousBuf := Canvas.ActiveFrameBuffer;
148.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
149.   Canvas.ActiveFrameBuffer := buf;
150.   Canvas.Fill(BGRAPixelTransparent);
151.   previousShader := Canvas.Lighting.ActiveShader;
152.   Canvas.Lighting.ActiveShader := self;
153.   ATexture.Draw(0, 0);
154.   Canvas.Lighting.ActiveShader := previousShader;
155.   Canvas.ActiveFrameBuffer := previousBuf;
156.   result := buf.MakeTextureAndFree;
157.  
158.   // canvas renderer
159.   //previousBuf := Canvas.ActiveFrameBuffer;
160.   //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
161.   //Canvas.ActiveFrameBuffer := buf;
162.   //Canvas.Fill(BGRAPixelTransparent);
163.   //RenderOnCanvas;
164.   //Canvas.ActiveFrameBuffer := previousBuf;
165.   //result := buf.MakeTextureAndFree;
166.  
167. end;
168.  
169. procedure TBGLKaleidoscopeShader.RenderOnCanvas;
170. var
171.   previousShader: TBGLCustomShader;
172. begin
173.   previousShader := Canvas.Lighting.ActiveShader;
174.   Canvas.Lighting.ActiveShader := self;
175.   CanvasSize := PointF(800,600);
176.   Canvas.FillRect(0, 0, 800,600, CSSWhite);
177.   Canvas.Lighting.ActiveShader := previousShader;
178. end;
179. end.

[lainz]

 

Awesome!!

[Gigatron]

Hi,
I'm currently watching the Olympics games so not much time however a conversion of a nice shader with the bgra component was inevitable; I send the video to YT for the result;

https://www.youtube.com/watch?v=F4nHntYCImc

Regards

Gtr

[Gigatron]

Hi ,

Let's make another shader with BGRA component to manipulate texture image, it can doable with BGRA transform function but
made with shader.
The result on YT video :

https://www.youtube.com/watch?v=Xmb5e1ySEUU

** The next shader will be a Textured Cube-Map !!

Main unit:

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.    Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   Buttons, BGLVirtualScreen, BGRAOpenGL, BGRACMapShader,BGRATextFX,
10.   BGRAGradients,BGRAFontGL, BGRABitmapTypes,RayLib ; // raylib unit
11.  
12. type
13.  
14.   { TForm1 }
15.  
16.   TForm1 = class(TForm)
17.     BGLVirtualScreen1: TBGLVirtualScreen;
18.     Timer1: TTimer;
19.     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;
20.       ElapsedMs: integer);
21.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
22.       BGLContext: TBGLContext);
23.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
24.     procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;
25.       BGLContext: TBGLContext);
26.     procedure FormCreate(Sender: TObject);
27.     procedure FormDestroy(Sender: TObject);
28.     procedure Timer1Timer(Sender: TObject);
29.  
30.    private
31.     cmap_shader: TBGLCMapShader;
32.     GLBigFont: IBGLFont;
33.     bigFont: TBGLRenderedFont;
34.   public
35.    texture,gl_surface,phenix : IBGLTexture;
36.    fnt,fntw : IBGLFont;
37.    rdtimer,xpos,ypos,rdtx,txpos: integer;
38.    txt : String;
39.    zval : single;
40.    rez  : single;
41.    rotx,roty,rotz,skew_x,skew_y,rr,gg,bb,intensity : single;
42.    alfa : byte;
43.    fade : boolean;
44.  
45.    demo_timer : integer;
46.  
47.    procedure RotationXYZ;
48.    procedure Fadein;
49.    procedure Fadeout;
50.  
51.  
52.   end;
53.  
54. var
55.   Form1: TForm1;
56.   music:TMusic;
57.  
58.  
59. implementation
60.  
61. {$R *.lfm}
62.  
63. { TForm1 }
64.  
65.  
66. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
67.   BGLContext: TBGLContext);
68. begin
69.          // le traitement du sampler2D comme texture
70.      cmap_shader.ImageIndex:= 0;
71.      gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader
72.      BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); //   surface qui contient le shader
73.      GLBigFont.TextOut(800-xpos,520,txt,BGRA(250,250,250,255));
74.      BGLContext.Canvas.PutImage(txpos,ypos,phenix,BGRA(255,255,255,alfa));
75.  
76.      bigFont.Color := BGRA(0,220,255,255);
77.  
78. end;
79.  
80. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
81.   BGLContext: TBGLContext);
82.  
83. var bigRender: TBGRATextEffectFontRenderer;
84.   shader : TPhongShading;
85.  
86. begin
87.     gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
88.     texture     := BGLTexture(ResourceFile('girl5.png'));
89.     phenix    := BGLTexture(ResourceFile('gtrn.png'));
90.     cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);
91.     // font
92.     shader := TPhongShading.Create;
93.     shader.LightPosition := Point(100, 100);
94.     shader.LightPositionZ:=5;
95.     shader.AmbientFactor:=0.2;
96.     shader.SpecularFactor:=1.0;
97.     shader.LightSourceDistanceTerm := 200;
98.     shader.LightColor:=BGRA(255,255,255,255);
99.     bigRender := TBGRATextEffectFontRenderer.Create(shader, true);
100.     bigFont  := TBGLRenderedFont.Create(bigRender, true);
101.     bigFont.Name := 'BlackWhiteBlock';
102.     bigFont.EmHeight := 72;
103.  
104.     GLBigFont := bigFont;
105.  
106. end;
107.  
108. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
109.   BGLContext: TBGLContext);
110. begin
111.           // libere et vire tout !!
112.   texture    := nil;
113.   gl_surface := nil;
114.   GLBigFont := nil;
115.   FreeAndNil(cmap_shader);
116. end;
117.  
118. procedure TForm1.FormCreate(Sender: TObject);
119. begin
120.    xpos:= -1600;
121.    ypos:=1000;
122.    rdtimer :=0;
123.    alfa :=1;
124.    fade :=false;
125.    txt := ' HELLO    GIGATRON   PRESENTS   BGRA   GL   SHADER    EXAMPLE    THIS    TIME   WE   CAN   CHANGE   UNIFORMS   ON   THE   FLY   SFX : BY  KARSTEN  KOCH  ARYX  S3M  CONVERTED  TO  FASTTRACKER  MODULE  THANX  TO  CIRCULAR  FOR  THE  BEST  COMPONENT  BGRA  .  GUVACODE  FOR  RAYLAZ  USED  TO  PLAY  XM   OR   MOD    FORMAT  . GREETINGS  TO  THE  LAZARUS  FPC  TEAM  AND  THE  MEMBERS  OF   QUANTUM   TECHNOLOGY  !!!!  SEE YOU  ....';
126.  
127.    zval :=0;
128.    rez  :=16.0;
129.  
130.    rotz :=0.0;
131.    rotx :=0.0;
132.    roty :=0.0;
133.    rr   := 1.0;
134.    gg   := 1.0;
135.    bb   := 1.0;
136.    intensity :=1.0;
137.  
138.  // Initialization audio + load module
139.   InitAudioDevice();
140.   music := LoadMusicStream(PChar(GetApplicationDirectory + 'aryx.xm'));    // xm module
141.   music.looping := false;
142.   SetMusicPitch(music,1.05);
143.   PlayMusicStream(music);
144. end;
145.  
146. procedure TForm1.FormDestroy(Sender: TObject);
147. begin
148.  
149. end;
150.  
151. procedure TForm1.Timer1Timer(Sender: TObject);
152. begin
153.    inc(demo_timer);
154.    inc(rdtimer);
155.  
156.    inc(xpos,4);
157.    if(xpos>24000) then
158.    begin
159.    xpos :=24000;
160.    end;
161.  
162.    if(ypos>0) then dec(ypos,30) else ypos:=0;
163.    if(demo_timer>200)  then  fade := true;
164.    if(demo_timer>1200)  then  fade := false;
165.    if(demo_timer>1400)  then  RotationXYZ;
166.  
167.    if(demo_timer>4000)  then  fade := true;
168.  
169.    if fade then Fadein;
170.    if not fade then Fadeout;
171.  
172.  
173.    if(rdtimer>100+Random(200)) then
174.    begin
175.       rr := Random(255)/255;
176.       gg := Random(255)/255;
177.       bb := Random(255)/255;
178.       rdtimer :=0;
179.      intensity := 1.0 +Random(255)/255;
180.  
181.    end;
182.  
183.     skew_x :=   0.08*sin(Round(demo_timer)*0.05);
184.     skew_y :=   0.08*sin(Round(demo_timer)*0.02);
185.  
186.    BGLVirtualScreen1.Invalidate;
187. end;
188.  
189. procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;
190.   BGLContext: TBGLContext; ElapsedMs: integer);
191. begin
192.  
193.    // sprite uniforms
194.    cmap_shader.Time   := cmap_shader.Time + 0.004;
195.    cmap_shader.Zoom := zval;
196.  
197.    if(zval<9.0) then zval:=zval + 0.02;
198.  
199.    if(rez<512.0) then rez:=rez + 1.0;
200.  
201.    cmap_shader.Transx := -0.40;
202.    cmap_shader.Transy := -0.80;
203.    cmap_shader.Factor:= rez;
204.  
205.    cmap_shader.Skewx:= skew_x;
206.    cmap_shader.Skewy:= skew_y;
207.  
208.    cmap_shader.Rotx := rotx;
209.    cmap_shader.Roty := roty;
210.    cmap_shader.Rotz := rotz-0.5;
211.  
212.    cmap_shader.Red       := rr;
213.    cmap_shader.Green     := gg;
214.    cmap_shader.Blue      := bb;
215.  
216.    cmap_shader.Intensity := intensity;
217.  
218.    Upda]"]>BlockedsicStream(music);       // Update music buffer with new stream data only here !!
219.  
220.  
221. end;
222.  
223. procedure TForm1.RotationXYZ();
224. begin
225.   if(rotx>-4.0) then rotx:= rotx -0.01;
226.   if(rotx<=-4.0) then
227.   begin
228.   if(roty>-4.0) then  roty := roty -0.01;
229.  
230.   if(roty<=-4.0) then
231.   begin
232.      if(rotz>-4.0) then  rotz := rotz -0.005;
233.  
234.  
235.      if(rotz<=-4.0) then
236.      begin
237.          rotx:= rotx -0.005;
238.          roty := roty -0.01;
239.          rotz := rotz +0.005;
240.  
241.      end;
242.   end;
243.  
244.   end;
245.  
246.  
247. end;
248.  
249.  
250.  
251. procedure TForm1.Fadein();
252. begin
253.    if alfa<>255 then inc(alfa);
254. end;
255.  
256. procedure TForm1.Fadeout();
257. begin
258.   if alfa<>1 then dec(alfa);
259. end;
260.  
261. end.
262.  
263.  

[Gigatron]

Here is the shader Unit ;

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

1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
2.  
3. unit BGRACMapShader;
4.  
5. {$mode objfpc}{$H+}
6.  
7. interface
8.  
9. uses
10.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
11.  
12. type
13.  
14.   TBGLCMapShader = class(TBGLShader3D)
15.  
16.   private
17.  
18.   function GetCanvasSize: TPointF;
19.   procedure SetCanvasSize(AValue: TPointF);
20.  
21.   protected
22.     FTime: TUniformVariableSingle;
23.     FTimer : Single;
24.     FFact: TUniformVariableSingle;
25.     FFactV : Single;
26.     // sprite utility uniforms :) 50000 uniforms
27.     FDebug  : TUniformVariableSingle;
28.     FDebugV : Single;
29.     FRotx  : TUniformVariableSingle;
30.     FRotxV : Single;
31.     FRoty  : TUniformVariableSingle;
32.     FRotyV : Single;
33.     FRotz  : TUniformVariableSingle;
34.     FRotzV : Single;
35.    // -- translate xy + roll xy
36.     FTrx  : TUniformVariableSingle;
37.     FTrxV : Single;
38.     FTry  : TUniformVariableSingle;
39.     FtryV : Single;
40.     FRlx  : TUniformVariableSingle;
41.     FRlxV : Single;
42.     FRly  : TUniformVariableSingle;
43.     FRlyV : Single;
44.    //  skew
45.     FSkewx  : TUniformVariableSingle;
46.     FSkewxV : Single;
47.     FSkewy  : TUniformVariableSingle;
48.     FSkewyV : Single;
49.     Fzoom   : TUniformVariableSingle;
50.     FzoomV  : Single;
51.     // colors
52.     FRed     : TUniformVariableSingle;
53.     FRedV    : Single;
54.     FGreen   : TUniformVariableSingle;
55.     FGreenV  : Single;
56.     FBlue    : TUniformVariableSingle;
57.     FBlueV   : Single;
58.     // intensity
59.     Fintensity  : TUniformVariableSingle;
60.     FintensityV : Single;
61.  
62.  
63.     FImageIndex: TUniformVariableInteger;
64.     FImage_idx : Integer;
65.  
66.     FCanvasSize: TUniformVariablePointF;
67.     procedure StartUse; override;
68.  
69.   public
70.  
71.     constructor Create(ACanvas: TBGLCustomCanvas);
72.     function Render(ATexture: IBGLTexture): IBGLTexture; overload;
73.      procedure RenderOnCanvas;
74.     // propriete  ecriture des uniforms
75.     property Time: Single read FTimer write FTimer;
76.     property Factor: Single read FFactV write FFactV;
77.     // uniforms for sprite utility
78.     property Debug: Single read FDebugV write FDebugV;
79.     property Rotx:  Single read FRotxV  write FRotxV;
80.     property Roty:  Single read FRotyV  write FRotyV;
81.     property Rotz:  Single read FRotzV  write FRotzV;
82.  
83.     property Transx: Single read FTrxV  write FTrxV;
84.     property Transy: Single read FTryV  write FTryV;
85.     property Rolx:   Single read FRlxV  write FRlxV;
86.     property Roly:   Single read FRlyV  write FRlyV;
87.  
88.     property Skewx:  Single read FSkewxV  write FSkewxV;
89.     property Skewy:  Single read FSkewyV  write FSkewyV;
90.  
91.     property Zoom:  Single read FzoomV  write FzoomV;
92.  
93.     property Red  :  Single read FRedV  write FRedV;
94.     property Green:  Single read FGreenV  write FGreenV;
95.     property Blue :  Single read FBlueV  write FBlueV;
96.  
97.     property Intensity :  Single read FintensityV  write FintensityV;
98.  
99.  
100.     property ImageIndex: integer read FImage_idx write FImage_idx;
101.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
102.  
103.   end;
104.  
105. implementation
106.  
107. function TBGLCMapShader.GetCanvasSize: TPointF;
108. begin
109.   result := FCanvasSize.Value;
110. end;
111.  
112. procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);
113. begin
114.   FCanvasSize.Value := AValue;
115. end;
116.  
117.  
118. { TBGLCMapShader }
119.  
120. constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas);
121.  
122. begin
123. // vertex
124. inherited Create(ACanvas,
125. 'uniform vec2 canvasSize;'#10 +
126. 'void main(void) {'#10 +
127. '  gl_Position = gl_ProjectionMatrix * gl_Vertex  ;'#10 +
128. '  gl_FrontColor = gl_Color;'#10 +
129. ' //texCoord = gl_Vertex.xy / canvasSize;'#10 +
130. ' texCoord = vec2(gl_MultiTexCoord0) ;'#10 +
131. '}',
132.  
133. // fragment shader
134. 'out vec4 FragmentColor;'#10 +
135. 'uniform float time;'#10+
136. 'uniform float fct;'#10+
137. 'uniform sampler2D image;'#10+
138.  
139. 'uniform float debug;'#10+
140. 'uniform float rot_x;'#10+
141. 'uniform float rot_y;'#10+
142. 'uniform float rot_z;'#10+
143. 'uniform float trx,try,rlx,rly;        '#10+
144. 'uniform float skewx,skewy;            '#10+
145. 'uniform float zoom;                   '#10+
146. 'uniform float intensity,bg_red,bg_green,bg_blue;'#10+
147. 'uniform float cmode,slmode,rmode;               '#10+
148.  
149.  
150. '#define Pi 3.14159265359                                                   '#10+
151. '                                                                           '#10+
152. 'vec3 planeInt(vec3 normal, vec3 rayorg, vec3 raydir) {                     '#10+
153. 'return rayorg + (raydir * (dot(-rayorg, normal) / dot(normal, raydir)));   '#10+
154. '}                                                                          '#10+
155. '                                                                           '#10+
156. 'mat4 setTranslation( float x, float y, float z )                           '#10+
157. '{                                                                          '#10+
158. '    return mat4( 1.0, 0.0, 0.0, 0.0,                                       '#10+
159. '                                0.0, 1.0, 0.0, 0.0,                        '#10+
160. '                                rlx, rly, 1.0, 0.0,                        '#10+
161. '                                x,     y,   z, 1.0 );                      '#10+
162. '}                                                                          '#10+
163. '                                                                           '#10+
164. ' mat3 xrot(float t)                                                        '#10+
165. '{                                                                          '#10+
166. '    return mat3(1.0, 0.0, 0.0,                                             '#10+
167. '                0.0, cos(t), -sin(t),                                      '#10+
168. '                0.0, sin(t), cos(t));                                      '#10+
169. '}                                                                          '#10+
170. '                                                                           '#10+
171. 'mat3 yrot(float t)                                                         '#10+
172. '{                                                                          '#10+
173. '    return mat3(cos(t), 0.0, -sin(t),                                      '#10+
174. '                0.0, 1.0, 0.0,                                             '#10+
175. '                sin(t), 0.0, cos(t));                                      '#10+
176. '}                                                                          '#10+
177. '                                                                           '#10+
178. 'mat3 zrot(float t)                                                         '#10+
179. '{                                                                          '#10+
180. '    return mat3(cos(t), -sin(t), 0.0,                                      '#10+
181. '                sin(t), cos(t), 0.0,                                       '#10+
182. '                0.0, 0.0, 1.0);                                            '#10+
183. '}                                                                          '#10+
184. '                                                                           '#10+
185. '                                                                           '#10+
186. 'vec3 rotateEuler(vec3 position, vec3 a) {                                  '#10+
187. '    mat4 rx = mat4(1., 0., 0., 0.,                                         '#10+
188. '                  0., cos(a.x), -sin(a.x), 0.,                             '#10+
189. '                  0., sin(a.x), cos(a.x), 0.,                              '#10+
190. '                  0., 0., 0., 1.);                                         '#10+
191. '    mat4 ry = mat4(cos(a.y), 0., sin(a.y), 0.,                             '#10+
192. '                  0.,        1., 0.,     0.,                               '#10+
193. '                  -sin(a.y), 0., cos(a.y),0.,                              '#10+
194. '                  0.,           0., 0.,          1.);                      '#10+
195. '    mat4 rz = mat4(cos(a.z), -sin(a.z), 0., 0.,                            '#10+
196. '                  sin(a.z),  cos(a.z),  0., 0.,                            '#10+
197. '                  0.,           0.,            1., 0.,                     '#10+
198. '                  0.,           0.,            0., 1.);                    '#10+
199. '    mat4 r = rx * ry * rz;                                                 '#10+
200. '    return (vec4(position, 1.) * r).xyz;                                   '#10+
201. '}                                                                          '#10+
202.  
203. 'void main()'#10 +
204. '{'#10 +
205. '//vec2 uv =  texCoord.xy   ;                                   '#10+
206. // flip y
207. //' uv.y = 1.-uv.y;                                           '#10+
208. // resolution down
209. //'uv = floor(256.0*uv)/256.0;'#10+
210. // texture xy_position
211. 'vec2  xy_pos = vec2(0.09,0.25);'#10+
212.  
213. 'vec3 dir = normalize(vec3(texCoord*2.-1.0 , 5.));'#10+
214. 'vec3 eye = vec3(trx,try,zoom);                             '#10+
215. 'float scl = mod(gl_FragCoord.y ,3.0)*mod(gl_FragCoord.y ,3.0);'#10+
216.  
217. '    float v = sin(time);                                        '#10+
218. '    float x = v * Pi;                                           '#10+
219. '    float y = v * Pi;                                           '#10+
220. '    vec3 r = vec3(rot_y*Pi, rot_x*Pi,rot_z*Pi);                 '#10+
221.  
222. '                                                                '#10+
223. '    vec3 pNormal = rotateEuler (vec3(0.0,0.0,1.0), r);          '#10+
224. '    vec3 pTangent = rotateEuler(vec3(0.0,1.0,0.0), r);          '#10+
225. '                                                                '#10+
226. '    vec3 pBitangent = cross(pTangent, pNormal);                 '#10+
227. '    vec3 i = planeInt(pNormal, eye, dir);                       '#10+
228. '                                                                '#10+
229. '                                                                '#10+
230. '    float sideT =   dot(i, pTangent) -  (Pi / 2.);                 '#10+
231. '    float sideBiT = dot(i, pBitangent) - (Pi / 2.);             '#10+
232. '   vec2  uv = (- 0.33) * (vec2(sideT, sideBiT));             '#10+
233. '                                                                 '#10+
234. '               uv   =  floor(uv*fct)/fct;                    '#10+
235. '           uv.x =1.-uv.x;                                       '#10+
236. '               //***********************                        '#10+
237. '               float xx = uv.x;                                 '#10+
238. '               float yy = uv.y;                                 '#10+
239. '               float m = (xx-0.5)*(xx+0.5)+sin(time);        '#10+
240. '                                                                '#10+
241. '               //uv.y = uv.y + m*cmode;                         '#10+
242. '               //uv.x = uv.x + m*cmode;                         '#10+
243. '                                                                '#10+
244. '               uv.y += uv.x*skewy ; // sky                      '#10+
245. '               uv.x += uv.y*skewx;                              '#10+
246. '               //****************************                   '#10+
247. '       vec3 tx = texture2D(image, uv - xy_pos ).xyz;            '#10+
248. 'if (uv.x < 1. && uv.y < 1. && uv.x > 0. && uv.y > 0.) {                      '#10+
249. '                                                                             '#10+
250. '  gl_FragColor = vec4(tx.r*bg_red,tx.g*bg_green,tx.b*bg_blue,1.0)* intensity; '#10+
251. '} else {                                                                   '#10+
252. '                                                                          '#10+
253. '               if(debug==1.0) gl_FragColor = vec4(0.1, 0.6, .9, 1.0);     '#10+
254. '        else                                                              '#10+
255. '               gl_FragColor = vec4(0.0, 0.0, .0, 0.0);                    '#10+
256. '                                                                          '#10+
257. '}                                                                         '#10+
258.  
259.  
260.  
261. '}',
262. 'varying vec2 texCoord;', '130');
263.  
264.   FTime := UniformSingle['time'];      // float uniform
265.   FFact := UniformSingle['fct'];       // reserved
266.  
267.   FDebug := UniformSingle['debug'];
268.   FRotx  := UniformSingle['rot_x'];
269.   FRoty  := UniformSingle['rot_y'];
270.   FRotz  := UniformSingle['rot_z'];
271.  
272.   FTrx   := UniformSingle['trx'];
273.   FTry   := UniformSingle['try'];
274.   FRlx   := UniformSingle['rlx'];
275.   FRly   := UniformSingle['rly'];
276.  
277.   FSkewx := UniformSingle['skewx'];
278.   FSkewy := UniformSingle['skewy'];
279.   Fzoom  := UniformSingle['zoom'];
280.  
281.   FRed   := UniformSingle['bg_red'];
282.   FGreen := UniformSingle['bg_green'];
283.   FBlue  := UniformSingle['bg_blue'];
284.  
285.   Fintensity := UniformSingle['intensity'];
286.  
287.  
288.   FImageIndex := UniformInteger['image'];
289.   FCanvasSize := UniformPointF['canvasSize'];
290.   FImage_idx:= 0;
291.   FTimer := 0;
292.   FFactV := 0.0;
293.   FzoomV:= 2.0;
294. end;
295.  
296. procedure TBGLCMapShader.StartUse;
297. begin
298.   inherited StartUse;
299.   FTime.Update;
300.   FTime.Value:=FTimer;
301.   FImageIndex.Update;
302.   // set values to uniforms
303.  
304.   FFact.Update;
305.   FFact.Value:= FFactV;
306.   FCanvasSize.Update;
307.   // sprite
308.   Fzoom.Update;
309.   Fzoom.Value:=FzoomV;
310.  
311.   FSkewx.Update;
312.   FSkewx.Value:= FSkewxV;
313.   FSkewy.Update;
314.   FSkewy.Value:= FSkewyV;
315.  
316.   FRlx.Update;
317.   FRly.Update;
318.   Frlx.Value:= FRlxV;
319.   Frly.Value:= FRlyV;
320.  
321.   FTrx.Update;
322.   FTry.Update;
323.   FTrx.Value:= FTrxV;
324.   FTry.Value:= FTryV;
325.  
326.   FRotx.Update;
327.   FRoty.Update;
328.   FRotz.Update;
329.   FRotx.Value:= FRotxV;
330.   FRoty.Value:= FRotyV;
331.   FRotz.Value:= FRotzV;
332.  
333.   FRed.Update;
334.   FGreen.Update;
335.   FBlue.Update;
336.   FRed.Value   := FRedV;
337.   FGreen.Value := FGreenV;
338.   FBlue.Value  := FBlueV;
339.  
340.   FIntensity.Update;
341.   Fintensity.Value:= FintensityV;
342.  
343. end;
344.  
345. function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;
346. var previousBuf,buf: TBGLCustomFrameBuffer;
347.   previousShader: TBGLCustomShader;
348. begin
349.   previousBuf := Canvas.ActiveFrameBuffer;
350.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
351.   Canvas.ActiveFrameBuffer := buf;
352.  // Canvas.Fill(BGRAPixelTransparent);
353.    Canvas.FillRect(0, 0, 800,600, CSSBlack);
354.   previousShader := Canvas.Lighting.ActiveShader;
355.   Canvas.Lighting.ActiveShader := self;
356.   ATexture.Draw(0, 0);
357.  // Atexture.StretchDraw(0,0,800+200,600,BGRA(255,255,255,255));
358.   Canvas.Lighting.ActiveShader := previousShader;
359.   Canvas.ActiveFrameBuffer := previousBuf;
360.   result := buf.MakeTextureAndFree;
361.  
362.   // canvas renderer
363.   //previousBuf := Canvas.ActiveFrameBuffer;
364.   //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
365.   //Canvas.ActiveFrameBuffer := buf;
366.   //Canvas.Fill(BGRAPixelTransparent);
367.   //RenderOnCanvas;
368.   //Canvas.ActiveFrameBuffer := previousBuf;
369.   //result := buf.MakeTextureAndFree;
370.  
371. end;
372.  
373. procedure TBGLCMapShader.RenderOnCanvas;
374. var
375.   previousShader: TBGLCustomShader;
376. begin
377.   previousShader := Canvas.Lighting.ActiveShader;
378.   Canvas.Lighting.ActiveShader := self;
379.   CanvasSize := PointF(800,600);
380.   Canvas.FillRect(0, 0, 800,600, CSSBlack);
381.   Canvas.Lighting.ActiveShader := previousShader;
382. end;
383. end.
384.  

[Gigatron]

Hi, made a quick demo with the new shader;
Will include cleaned code here after removing some stuff like starfield etc.

Result on YT :

https://www.youtube.com/watch?v=8dEqSzHQrtY

Projet is now included in zip format;
The texture must be power of two ,2,4,8,16,32,64,128,256,512,1024,2048,4096,8196 ... this mean
the size must be power of 2; 256x256 is an example of texture size : width = 256 height = 256

Regards

[Gigatron]

Hi,
Today i presents another glsl shader demo called 8 bit colors.
This shader reduce color  texture to , TWOBGS, BW, NES, EGA, CPC-464, CGA, GAMEBOY, TELETEXT, SMS, C-64, Z-80, MSX.
The original code is from shadertoy and include some console palettes by me, matrix dither is removed pixelate mode used.

So look the code and result on YT :
https://www.youtube.com/watch?v=etpXRk92Mfs

Main unit;

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

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, BGRACMapShader, 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.       OpenDialog1: TOpenDialog;
21.     Timer1: TTimer;
22.     procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext;
23.       ElapsedMs: integer);
24.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
25.       BGLContext: TBGLContext);
26.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
27.     procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;
28.       BGLContext: TBGLContext);
29.     procedure Button1Click(Sender: TObject);
30.     procedure FormCreate(Sender: TObject);
31.     procedure FormPaint(Sender: TObject);
32.     procedure Timer1Timer(Sender: TObject);
33.  
34.     procedure LoadPicture();
35.  
36.    private
37.     cmap_shader: TBGLCMapShader;
38.     GLBigFont: IBGLFont;
39.     bigFont: TBGLRenderedFont;
40.  
41.    public
42.     texture0,gl_surface,phenix: IBGLTexture;
43.     barreHaut,barreBas :IBGLTexture;
44.  
45.   end;
46.  
47. var
48.   Form1: TForm1;
49.   txt : String= 'GIGATRON THE LEADER PRESENTS ANOTHER BGRA GL SHADER DEMO EXAMPLE  - 8 BIT COLORS - BASE SOURCE FROM SHADERTOY  TWOBGS, BW, NES, EGA, CPC-464, CGA, GAMEBOY, TELETEXT, SMS, C-64, Z-80, MSX  .. SFX : TURTLE    GFX : GUWEIZ   GREETING LIST IN ORDER :  CIRCULAR  GUVACODE  TRONIC-DESIGN  MAGIC-FACTORY  LAZARUS FPC TEAM AND THE MEMBERS OF QUANTUM TECHNOLOGY !!!!SEE YOU ON NEXT DEMO BYE!!! ....' ;
50.   xpos : integer;
51.   x_sin : single;
52.   demo_timer,effect_timer,cmode : integer;
53.   alfa : byte;
54.  
55.   music:TMusic;
56.  
57. implementation
58.  
59. {$R *.lfm}
60.  
61. { TForm1 }
62.  
63. procedure TForm1.FormCreate(Sender: TObject);
64. begin
65.   demo_timer :=0 ;
66.   xpos:= -160;
67.   // Initialization audio + load module
68.   InitAudioDevice();
69.   music := LoadMusicStream(PChar(GetApplicationDirectory + 'sublimity.mod'));    // xm module
70.   music.looping := true;
71.  // SetMusicPitch(music,1.05);
72.   PlayMusicStream(music);
73. end;
74.  
75. procedure TForm1.FormPaint(Sender: TObject);
76. begin
77.  
78. end;
79.  
80. procedure TForm1.Timer1Timer(Sender: TObject);
81. begin
82.  
83.  BGLVirtualScreen1.Invalidate;
84.  
85. end;
86.  
87. procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject;
88.   BGLContext: TBGLContext; ElapsedMs: integer);
89.   var bigRender: TBGRATextEffectFontRenderer;
90.   shader : TPhongShading;
91. begin
92.     // cmap_shader.Time := cmap_shader.Time +0.004;
93.      cmap_shader.Cmode:=cmode;
94.      if (cmode>0) then cmap_shader.Intensity := 1.50
95.      else
96.      cmap_shader.Intensity :=1.0;
97.  
98.    inc(xpos,2);
99.    if(xpos>24000) then
100.    begin
101.    xpos :=24000;
102.    end;
103.    inc(effect_timer);
104.    inc(demo_timer);
105.  
106.    if(demo_timer>100) then
107.    begin
108.      if alfa<>255 then inc(alfa);
109.    end;
110.   if(demo_timer>400) then  x_sin := x_sin +0.02;
111.  
112.    if(effect_timer>500) then
113.    begin
114.    cmode:=cmode +1;
115.    if(cmode>=13) then cmode :=0;
116.    effect_timer :=0;
117.    end;
118.  
119.  
120. end;
121.  
122. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
123.   BGLContext: TBGLContext);
124.  
125.   var bigRender: TBGRATextEffectFontRenderer;
126.     shader : TPhongShading;
127.  
128. begin
129.    texture0     := BGLTexture(ResourceFile('girl512-4.png'));  // texture must power of TWO size !!
130.    gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
131.    phenix    := BGLTexture(ResourceFile('gtr.png'));
132.    cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);
133.    // les barres
134.     barreHaut     := BGLTexture(ResourceFile('barre_haut.png'));
135.     barreBas     := BGLTexture(ResourceFile('barre_bas.png'));
136.     // font
137.     shader := TPhongShading.Create;
138.     shader.LightPosition := Point(10, 100);
139.     shader.LightPositionZ:=20;
140.     shader.AmbientFactor:=0.2;
141.     shader.SpecularFactor:=1.0;
142.     shader.LightSourceDistanceTerm := 200;
143.     shader.LightColor:=BGRA(255,255,255,255);
144.     bigRender := TBGRATextEffectFontRenderer.Create(shader, true);
145.     bigFont  := TBGLRenderedFont.Create(bigRender, true);
146.     bigFont.Name := 'Dynamic Recompilation';
147.     bigFont.EmHeight := 24;
148.     //bigFont.Style:=[fsBold];
149.     GLBigFont := bigFont;
150.  
151.  
152. end;
153.  
154. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
155.   BGLContext: TBGLContext);
156. begin
157.  
158.      // le traitement du sampler2D comme texture
159.      cmap_shader.Image0 := 0;
160.      //cmap_shader.Intensity:= 1.0;
161.      gl_surface := cmap_shader.Render(texture0);   // container de l'image0 affichee par le shader
162.      BGLContext.Canvas.PutImage(0,0,texture0,BGRA(255,255,255,255));
163.      BGLContext.Canvas.StretchPutImage(0,0,800 ,600, gl_surface);
164.  
165.      BGLContext.Canvas.PutImage(0,0,barreHaut,BGRA(255,255,255,255));
166.      BGLContext.Canvas.PutImage(130+160.0*sin(x_sin)*0.8,0,phenix,BGRA(255,255,255,alfa));
167.      BGLContext.Canvas.PutImage(0,558,barreBas,BGRA(255,255,255,255));
168.      GLBigFont.TextOut(800-xpos,562,txt,BGRA(250,250,250,255));
169.      bigFont.Color := BGRA(25,25,25,255);
170.      Upda]"]>BlockedsicStream(music);       // Update music buffer with new stream data only here !!
171. end;
172.  
173. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
174.   BGLContext: TBGLContext);
175. begin
176.       // libere les textures et le shader !!
177.   texture0    := nil;
178.   gl_surface := nil;
179.  
180.   GLBigFont := nil;
181.   barreHaut:= nil;
182.   barreBas := nil;
183.   FreeAndNil(cmap_shader);
184.  
185.  
186.   FreeAndNil(cmap_shader);
187.  
188.  
189. end;
190.  
191. procedure TForm1.Button1Click(Sender: TObject);
192. begin
193.       LoadPicture();
194. end;
195.  
196. procedure TForm1.LoadPicture;
197.  
198. begin
199.         if (OpenDialog1.Execute) then
200.         begin
201.         texture0 := BGLTexture(ResourceFile(OpenDialog1.FileName));
202.  
203.         end;
204. end;
205.  
206.  
207. end.
208.  

[Gigatron]

Shader unit of the demo above ,  you can change the name of the unit yourself !

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

1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
2.  
3. unit BGRACMapShader;
4.  
5. {$mode objfpc}{$H+}
6.  
7. interface
8.  
9. uses
10.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
11.  
12. type
13.  
14.   TBGLCMapShader = class(TBGLShader3D)
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 TBGLCMapShader.GetCanvasSize: TPointF;
59. begin
60.   result := FCanvasSize.Value;
61. end;
62.  
63. procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);
64. begin
65.   FCanvasSize.Value := AValue;
66. end;
67.  
68.  
69. { TBGLCMapShader }
70.  
71. constructor TBGLCMapShader.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.  
84. // fragment shader
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. 'vec3 find_closest (in vec3 ref) {                                                       '#10+
92. 'vec3 old = vec3 (100.0*255.0);                                                          '#10+
93. '#define TRY_COLOR(new) old = mix (new, old, step (length (old-ref), length (new-ref))); '#10+
94. '                                                                                        '#10+
95. '                                                                                        '#10+
96. // TWOBGS
97. '    if(c_mode==1.0){                                                                    '#10+
98. '    TRY_COLOR (vec3 (000.0, 000.0, 000.0));                                             '#10+
99. '    TRY_COLOR (vec3 (103.0, 103.0, 103.0));                                             '#10+
100. '    TRY_COLOR (vec3 (184.0, 184.0, 184.0));                                             '#10+
101. '    TRY_COLOR (vec3 (255.0, 255.0, 255.0));                                             '#10+
102. '    }                                                                                   '#10+
103. // BW
104. '    if(c_mode==2.0){                                                                    '#10+
105. '    TRY_COLOR (vec3 (000.0, 000.0, 000.0));                                             '#10+
106. '    TRY_COLOR (vec3 (255.0, 255.0, 255.0));                                             '#10+
107. '    }                                                                                   '#10+
108.  
109. 'if(c_mode==3.0){                                '#10+
110. '    TRY_COLOR (vec3 (000.0, 000.0, 000.0));   '#10+
111. '    TRY_COLOR (vec3 (255.0, 000.0, 000.0));   '#10+
112. '    TRY_COLOR (vec3 (000.0, 255.0, 000.0));   '#10+
113. '    TRY_COLOR (vec3 (000.0, 000.0, 255.0));   '#10+
114. '    TRY_COLOR (vec3 (000.0, 255.0, 255.0));   '#10+
115. '    TRY_COLOR (vec3 (255.0, 000.0, 255.0));   '#10+
116. '    TRY_COLOR (vec3 (255.0, 255.0, 000.0));   '#10+
117. '    TRY_COLOR (vec3 (255.0, 255.0, 255.0));   '#10+
118. '    }                                           '#10+
119. 'if(c_mode==4.0){                                '#10+
120. '       TRY_COLOR (vec3 (000.0, 000.0, 000.0));    '#10+
121. '       TRY_COLOR (vec3 (080.0, 048.0, 000.0));    '#10+
122. '       TRY_COLOR (vec3 (000.0, 104.0, 000.0));    '#10+
123. '       TRY_COLOR (vec3 (000.0, 064.0, 088.0));    '#10+
124. '       TRY_COLOR (vec3 (000.0, 120.0, 000.0));    '#10+
125. '       TRY_COLOR (vec3 (136.0, 020.0, 000.0));    '#10+
126. '       TRY_COLOR (vec3 (000.0, 168.0, 000.0));    '#10+
127. '       TRY_COLOR (vec3 (168.0, 016.0, 000.0));    '#10+
128. '       TRY_COLOR (vec3 (168.0, 000.0, 032.0));    '#10+
129. '       TRY_COLOR (vec3 (000.0, 168.0, 068.0));    '#10+
130. '       TRY_COLOR (vec3 (000.0, 184.0, 000.0));    '#10+
131. '       TRY_COLOR (vec3 (000.0, 000.0, 188.0));    '#10+
132. '       TRY_COLOR (vec3 (000.0, 136.0, 136.0));    '#10+
133. '       TRY_COLOR (vec3 (148.0, 000.0, 132.0));    '#10+
134. '       TRY_COLOR (vec3 (068.0, 040.0, 188.0));    '#10+
135. '       TRY_COLOR (vec3 (120.0, 120.0, 120.0));    '#10+
136. '       TRY_COLOR (vec3 (172.0, 124.0, 000.0));    '#10+
137. '       TRY_COLOR (vec3 (124.0, 124.0, 124.0));    '#10+
138. '       TRY_COLOR (vec3 (228.0, 000.0, 088.0));    '#10+
139. '       TRY_COLOR (vec3 (228.0, 092.0, 016.0));    '#10+
140. '       TRY_COLOR (vec3 (088.0, 216.0, 084.0));    '#10+
141. '       TRY_COLOR (vec3 (000.0, 000.0, 252.0));    '#10+
142. '       TRY_COLOR (vec3 (248.0, 056.0, 000.0));    '#10+
143. '       TRY_COLOR (vec3 (000.0, 088.0, 248.0));    '#10+
144. '       TRY_COLOR (vec3 (000.0, 120.0, 248.0));    '#10+
145. '       TRY_COLOR (vec3 (104.0, 068.0, 252.0));    '#10+
146. '       TRY_COLOR (vec3 (248.0, 120.0, 088.0));    '#10+
147. '       TRY_COLOR (vec3 (216.0, 000.0, 204.0));    '#10+
148. '       TRY_COLOR (vec3 (088.0, 248.0, 152.0));    '#10+
149. '       TRY_COLOR (vec3 (248.0, 088.0, 152.0));    '#10+
150. '       TRY_COLOR (vec3 (104.0, 136.0, 252.0));    '#10+
151. '       TRY_COLOR (vec3 (252.0, 160.0, 068.0));    '#10+
152. '       TRY_COLOR (vec3 (248.0, 184.0, 000.0));    '#10+
153. '       TRY_COLOR (vec3 (184.0, 248.0, 024.0));    '#10+
154. '       TRY_COLOR (vec3 (152.0, 120.0, 248.0));    '#10+
155. '       TRY_COLOR (vec3 (000.0, 232.0, 216.0));    '#10+
156. '       TRY_COLOR (vec3 (060.0, 188.0, 252.0));    '#10+
157. '       TRY_COLOR (vec3 (188.0, 188.0, 188.0));    '#10+
158. '       TRY_COLOR (vec3 (216.0, 248.0, 120.0));    '#10+
159. '       TRY_COLOR (vec3 (248.0, 216.0, 120.0));    '#10+
160. '       TRY_COLOR (vec3 (248.0, 164.0, 192.0));    '#10+
161. '       TRY_COLOR (vec3 (000.0, 252.0, 252.0));    '#10+
162. '       TRY_COLOR (vec3 (184.0, 184.0, 248.0));    '#10+
163. '       TRY_COLOR (vec3 (184.0, 248.0, 184.0));    '#10+
164. '       TRY_COLOR (vec3 (240.0, 208.0, 176.0));    '#10+
165. '       TRY_COLOR (vec3 (248.0, 120.0, 248.0));    '#10+
166. '       TRY_COLOR (vec3 (252.0, 224.0, 168.0));    '#10+
167. '       TRY_COLOR (vec3 (184.0, 248.0, 216.0));    '#10+
168. '       TRY_COLOR (vec3 (216.0, 184.0, 248.0));    '#10+
169. '       TRY_COLOR (vec3 (164.0, 228.0, 252.0));    '#10+
170. '       TRY_COLOR (vec3 (248.0, 184.0, 248.0));    '#10+
171. '       TRY_COLOR (vec3 (248.0, 216.0, 248.0));    '#10+
172. '       TRY_COLOR (vec3 (248.0, 248.0, 248.0));    '#10+
173. '       TRY_COLOR (vec3 (252.0, 252.0, 252.0));  '#10+
174. '       }                                            '#10+
175. '                                                    '#10+
176. 'if(c_mode==5.0){                                '#10+
177. '       TRY_COLOR (vec3 (156.0, 189.0, 015.0));    '#10+
178. '       TRY_COLOR (vec3 (140.0, 173.0, 015.0));    '#10+
179. '       TRY_COLOR (vec3 (048.0, 098.0, 048.0));    '#10+
180. '       TRY_COLOR (vec3 (000.0, 000.0, 000.0));    '#10+
181. '       }                                            '#10+
182. '                                                '#10+
183. 'if(c_mode==6.0){                                '#10+
184. '    TRY_COLOR (vec3 (000.0,000.0,000.0));     '#10+
185. '    TRY_COLOR (vec3 (255.0,255.0,255.0));     '#10+
186. '    TRY_COLOR (vec3 (255.0,  0.0,  0.0));     '#10+
187. '    TRY_COLOR (vec3 (  0.0,255.0,  0.0));     '#10+
188. '    TRY_COLOR (vec3 (  0.0,  0.0,255.0));     '#10+
189. '    TRY_COLOR (vec3 (255.0,255.0,  0.0));     '#10+
190. '    TRY_COLOR (vec3  (  0.0,255.0,255.0));    '#10+
191. '    TRY_COLOR (vec3 (255.0,  0.0,255.0));     '#10+
192. '    TRY_COLOR (vec3 (128.0,  0.0,  0.0));     '#10+
193. '    TRY_COLOR (vec3 (  0.0,128.0,  0.0));     '#10+
194. '    TRY_COLOR (vec3 (  0.0,  0.0,128.0));     '#10+
195. '    TRY_COLOR (vec3 (128.0,128.0,  0.0));     '#10+
196. '    TRY_COLOR (vec3 (  0.0,128.0,128.0));     '#10+
197. '    TRY_COLOR (vec3 (128.0,  0.0,128.0));     '#10+
198. '    TRY_COLOR (vec3 (128.0,128.0,128.0));     '#10+
199. '    TRY_COLOR (vec3 (255.0,128.0,128.0));     '#10+
200. '    }                                           '#10+
201. '                                                '#10+
202. 'if(c_mode==7.0){                                '#10+
203. '    TRY_COLOR (vec3 (000.0,000.0,000.0));     '#10+
204. '    TRY_COLOR (vec3 (000.0,170.0,170.0));     '#10+
205. '    TRY_COLOR (vec3 (170.0,000.0,170.0));     '#10+
206. '    TRY_COLOR (vec3 (170.0,170.0,170.0));     '#10+
207. '    }                                           '#10+
208. '                                                '#10+
209. 'if(c_mode==8.0){                                '#10+
210. '    TRY_COLOR ( vec3(000.0,000.0,000.0));     '#10+
211. '    TRY_COLOR ( vec3(000.0,000.0,128.0));     '#10+
212. '    TRY_COLOR ( vec3(000.0,000.0,255.0));     '#10+
213. '    TRY_COLOR ( vec3(128.0,000.0,000.0));     '#10+
214. '    TRY_COLOR ( vec3(128.0,000.0,128.0));     '#10+
215. '    TRY_COLOR ( vec3(128.0,000.0,255.0));     '#10+
216. '    TRY_COLOR ( vec3(255.0,000.0,000.0));     '#10+
217. '    TRY_COLOR ( vec3(255.0,000.0,128.0));     '#10+
218. '    TRY_COLOR ( vec3(255.0,000.0,255.0));     '#10+
219. '    TRY_COLOR ( vec3(000.0,128.0,000.0));     '#10+
220. '    TRY_COLOR ( vec3(000.0,128.0,128.0));     '#10+
221. '    TRY_COLOR ( vec3(000.0,128.0,255.0));     '#10+
222. '    TRY_COLOR ( vec3(128.0,128.0,000.0));     '#10+
223. '    TRY_COLOR ( vec3(128.0,128.0,128.0));     '#10+
224. '    TRY_COLOR ( vec3(128.0,128.0,255.0));     '#10+
225. '    TRY_COLOR ( vec3(255.0,128.0,000.0));     '#10+
226. '    TRY_COLOR ( vec3(255.0,128.0,128.0));     '#10+
227. '    TRY_COLOR ( vec3(255.0,128.0,255.0));     '#10+
228. '    TRY_COLOR ( vec3(000.0,255.0,000.0));     '#10+
229. '    TRY_COLOR ( vec3(000.0,255.0,128.0));     '#10+
230. '    TRY_COLOR ( vec3(000.0,255.0,255.0));     '#10+
231. '    TRY_COLOR ( vec3(128.0,255.0,000.0));     '#10+
232. '    TRY_COLOR ( vec3(128.0,255.0,128.0));     '#10+
233. '    TRY_COLOR ( vec3(128.0,255.0,255.0));     '#10+
234. '    TRY_COLOR ( vec3(255.0,255.0,000.0));     '#10+
235. '    TRY_COLOR ( vec3(255.0,255.0,128.0));     '#10+
236. '    TRY_COLOR ( vec3(255.0,255.0,255.0));     '#10+
237. '    }                                           '#10+
238. '                                                '#10+
239. 'if(c_mode==9.0){                                '#10+
240. '     TRY_COLOR (vec3(0,0,0));                 '#10+
241. '     TRY_COLOR ( vec3(85,0,0));               '#10+
242. '     TRY_COLOR ( vec3(170,0,0));              '#10+
243. '     TRY_COLOR ( vec3(255,0,0));              '#10+
244. '        TRY_COLOR ( vec3(0,85,0));                '#10+
245. '     TRY_COLOR ( vec3(85,85,0));              '#10+
246. '     TRY_COLOR ( vec3(170,85,0));             '#10+
247. '     TRY_COLOR ( vec3(255,85,0));             '#10+
248. '        TRY_COLOR ( vec3(0,170,0));               '#10+
249. '     TRY_COLOR ( vec3(85,170,0));             '#10+
250. '     TRY_COLOR ( vec3(170,170,0));            '#10+
251. '     TRY_COLOR ( vec3(255,170,0));            '#10+
252. '        TRY_COLOR ( vec3(0,255,0));               '#10+
253. '     TRY_COLOR ( vec3(85,255,0));             '#10+
254. '     TRY_COLOR ( vec3(170,255,0));            '#10+
255. '     TRY_COLOR ( vec3(255,255,0));            '#10+
256. '        TRY_COLOR ( vec3(0,0,85));                '#10+
257. '     TRY_COLOR ( vec3(85,0,85));              '#10+
258. '     TRY_COLOR ( vec3(170,0,85));             '#10+
259. '     TRY_COLOR ( vec3(255,0,85));             '#10+
260. '        TRY_COLOR ( vec3(0,85,85));               '#10+
261. '        TRY_COLOR ( vec3(85,85,85));              '#10+
262. '        TRY_COLOR ( vec3(170,85,85));             '#10+
263. '     TRY_COLOR ( vec3(255,85,85));            '#10+
264. '     TRY_COLOR ( vec3(0,170,85));             '#10+
265. '     TRY_COLOR ( vec3(85,170,85));            '#10+
266. '        TRY_COLOR ( vec3(170,170,85));            '#10+
267. '     TRY_COLOR ( vec3(255,170,85));           '#10+
268. '     TRY_COLOR ( vec3(0,255,85));             '#10+
269. '     TRY_COLOR ( vec3(85,255,85));            '#10+
270. '        TRY_COLOR ( vec3(170,255,85));            '#10+
271. '        TRY_COLOR ( vec3(255,255,85));            '#10+
272. '        TRY_COLOR ( vec3(0,0,170));               '#10+
273. '     TRY_COLOR ( vec3(85,0,170));             '#10+
274. '     TRY_COLOR ( vec3(170,0,170));            '#10+
275. '     TRY_COLOR ( vec3(255,0,170));            '#10+
276. '        TRY_COLOR ( vec3(0,85,170));              '#10+
277. '     TRY_COLOR ( vec3(85,85,170));            '#10+
278. '     TRY_COLOR ( vec3(170,85,170));           '#10+
279. '     TRY_COLOR ( vec3(255,85,170));           '#10+
280. '        TRY_COLOR ( vec3(0,170,170));             '#10+
281. '        TRY_COLOR ( vec3(85,170,170));            '#10+
282. '        TRY_COLOR ( vec3(170,170,170));           '#10+
283. '     TRY_COLOR ( vec3(255,170,170));          '#10+
284. '     TRY_COLOR ( vec3(0,255,170));            '#10+
285. '     TRY_COLOR ( vec3(85,255,170));           '#10+
286. '        TRY_COLOR ( vec3(170,255,170));           '#10+
287. '     TRY_COLOR ( vec3(255,255,170));          '#10+
288. '     TRY_COLOR ( vec3(0,0,255));              '#10+
289. '     TRY_COLOR ( vec3(85,0,255));             '#10+
290. '        TRY_COLOR ( vec3(170,0,255));             '#10+
291. '     TRY_COLOR ( vec3(255,0,255));            '#10+
292. '        TRY_COLOR ( vec3(0,85,255));              '#10+
293. '     TRY_COLOR ( vec3(85,85,255));            '#10+
294. '     TRY_COLOR ( vec3(170,85,255));           '#10+
295. '        TRY_COLOR ( vec3(255,85,255));            '#10+
296. '        TRY_COLOR ( vec3(0,170,255));             '#10+
297. '     TRY_COLOR ( vec3(85,170,255));           '#10+
298. '     TRY_COLOR ( vec3(170,170,255));          '#10+
299. '        TRY_COLOR ( vec3(255,170,255));           '#10+
300. '        TRY_COLOR ( vec3(0,255,255));             '#10+
301. '     TRY_COLOR ( vec3(85,255,255));           '#10+
302. '     TRY_COLOR ( vec3(170,255,255));          '#10+
303. '        TRY_COLOR ( vec3(255,255,255));           '#10+
304. '    }                                           '#10+
305. 'if(c_mode==10.0){                               '#10+
306. '       TRY_COLOR(vec3(0,0,0)*255.0);// black      '#10+
307. '       TRY_COLOR(vec3(1,1,1)*255.0);// white      '#10+
308. '       TRY_COLOR(vec3(0.41,0.22,0.17)*255.0);     '#10+
309. '       TRY_COLOR(vec3(0.44,0.64,0.70)*255.0);     '#10+
310. '       TRY_COLOR(vec3(0.44,0.24,0.53)*255.0);     '#10+
311. '       TRY_COLOR(vec3(0.35,0.55,0.26)*255.0);     '#10+
312. '       TRY_COLOR(vec3(0.21,0.16,0.47)*255.0);     '#10+
313. '       TRY_COLOR(vec3(0.72,0.78,0.44)*255.0);     '#10+
314. '       TRY_COLOR(vec3(0.44,0.31,0.15)*255.0);     '#10+
315. '       TRY_COLOR(vec3(0.26,0.22,0.00)*255.0);     '#10+
316. '       TRY_COLOR(vec3(0.60,0.40,0.35)*255.0);     '#10+
317. '       TRY_COLOR(vec3(0.27,0.27,0.27)*255.0);     '#10+
318. '       TRY_COLOR(vec3(0.42,0.42,0.42)*255.0);     '#10+
319. '       TRY_COLOR(vec3(0.60,0.82,0.52)*255.0);     '#10+
320. '       TRY_COLOR(vec3(0.42,0.37,0.71)*255.0);     '#10+
321. '       TRY_COLOR(vec3(0.58,0.58,0.58)*255.0);     '#10+
322. '       }                                            '#10+
323. 'if(c_mode==11.0){                               '#10+
324. '       TRY_COLOR(vec3(0,0,0));// black            '#10+
325. '       TRY_COLOR(vec3(0,0,255.0));// bluez80      '#10+
326. '       TRY_COLOR(vec3(0,0,192.0));// bluez80      '#10+
327. '       TRY_COLOR(vec3(255.0,0,0));                '#10+
328. '       TRY_COLOR(vec3(192.0,0,0));                '#10+
329. '       TRY_COLOR(vec3(255.0,0,255.0));            '#10+
330. '       TRY_COLOR(vec3(192.0,0,192.0));          '#10+
331. '       TRY_COLOR(vec3(0,255.0,0));                '#10+
332. '       TRY_COLOR(vec3(0,192.0,0));                '#10+
333. '       TRY_COLOR(vec3(0,255.0,255.0));            '#10+
334. '       TRY_COLOR(vec3(0,192.0,192.0));            '#10+
335. '       TRY_COLOR(vec3(255.0,255.0,0));            '#10+
336. '       TRY_COLOR(vec3(192.0,192.0,0));            '#10+
337. '       TRY_COLOR(vec3(255.0,255.0,255.0));        '#10+
338. '       TRY_COLOR(vec3(192.0,192.0,192.0));        '#10+
339. '                                                        '#10+
340. '       }                                            '#10+
341. '                                                    '#10+
342. 'if(c_mode==12.0){                               '#10+
343. '       TRY_COLOR(vec3(0,0,0));// black            '#10+
344. '       TRY_COLOR(vec3(62.0, 184.0,73.0));         '#10+
345. '       TRY_COLOR(vec3(116.0, 208.0, 125.0));      '#10+
346. '       TRY_COLOR(vec3(89.0, 85.0, 224.0));        '#10+
347. '       TRY_COLOR(vec3(128.0, 118.0, 241.0));      '#10+
348. '       TRY_COLOR(vec3(185.0, 94.0, 81.0));        '#10+
349. '       TRY_COLOR(vec3(101.0, 219.0, 239.0));      '#10+
350. '       TRY_COLOR(vec3(219.0, 101.0, 89.0));       '#10+
351. '       TRY_COLOR(vec3(255.0, 137.0, 125.0));      '#10+
352. '       TRY_COLOR(vec3(204.0, 195.0, 94.0));       '#10+
353. '       TRY_COLOR(vec3(222.0, 208.0, 135.0));      '#10+
354. '       TRY_COLOR(vec3(58.0, 162.0, 65.0));        '#10+
355. '       TRY_COLOR(vec3(183.0, 102.0, 181.0));      '#10+
356. '       TRY_COLOR(vec3(204.0, 204.0, 204.0));      '#10+
357. '       TRY_COLOR(vec3(255.0, 255.0, 255.0));      '#10+
358. '       }                                          '#10+
359.  
360.  
361.  
362. 'return old ;                                                                            '#10+
363. '}                                                                                       '#10+
364.  
365. 'vec3 dither (vec3 color, vec2 uv) {                                                 '#10+
366. '       color *= 255.0 * intensity;                                                 '#10+
367. '       //color += dither_matrix (mod (uv.x, 8.0), mod (uv.y, 8.0)) ;                '#10+
368. '       color = find_closest (clamp (color, 0.0, 255.0));                            '#10+
369. '       return color / 255.0;                                                        '#10+
370. '}                                                                                   '#10+
371.  
372.  
373. 'void main()'#10 +
374. '{'#10 +
375. 'vec2 uv =  texCoord.xy   ;            '#10+
376. // flip y
377. ' uv.y = 1.-uv.y;                                           '#10+
378. // resolution down
379. 'uv = floor(256.0*uv)/256.0;'#10+
380. // texture xy_position
381. //'    vec2  xy_pos = vec2(0.09,0.25);'#10+
382.  
383.  
384.  
385. '       vec3 tx = texture(tex, uv ).xyz;                            '#10+
386. '       if(c_mode>=1.0)                                            '#10+
387. '       gl_FragColor =  vec4 (dither (tx, uv ),1.0);               '#10+
388. '       else                                                       '#10+
389. '       gl_FragColor =  vec4 (tx ,1.0)* intensity;                            '#10+
390.  
391. '}',
392. 'varying vec2 texCoord;', '130');
393.  
394.   FTime := UniformSingle['time'];      // float uniform
395.   Fintensity := UniformSingle['intensity'];
396.   FMode      := UniformSingle['c_mode'];
397.   FImage0    := UniformInteger['tex'];
398.   FCanvasSize := UniformPointF['canvasSize'];
399.   FImage0V   := 0;
400.   FTimer := 0;
401.   FintensityV := 1.0;
402.   FModeV := 1.0;
403.  
404.  
405. end;
406.  
407.  
408. procedure TBGLCMapShader.StartUse;
409. begin
410.   inherited StartUse;
411.   FTime.Update;
412.   FTime.Value:=FTimer;
413.   FImage0.Update;
414.   FImage0.Value:=FImage0V;
415.   FIntensity.Update;
416.   Fintensity.Value:= FintensityV;
417.   FMode.Update;
418.   FMode.Value:= FModeV;
419.  
420.  
421. end;
422.  
423. function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;
424. var previousBuf,buf: TBGLCustomFrameBuffer;
425.   previousShader: TBGLCustomShader;
426. begin
427.  
428.   previousBuf := Canvas.ActiveFrameBuffer;
429.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
430.   Canvas.ActiveFrameBuffer := buf;
431.  
432.   previousShader := Canvas.Lighting.ActiveShader;
433.   Canvas.Lighting.ActiveShader := self;
434.   ATexture.Draw(0, 0);
435.   Canvas.Lighting.ActiveShader := previousShader;
436.   Canvas.ActiveFrameBuffer := previousBuf;
437.   result := buf.MakeTextureAndFree;
438.  
439.  
440. end;
441.  
442. procedure TBGLCMapShader.RenderOnCanvas;
443. var
444.   previousShader: TBGLCustomShader;
445. begin
446.   previousShader := Canvas.Lighting.ActiveShader;
447.   Canvas.Lighting.ActiveShader := self;
448.   CanvasSize := PointF(800,600);
449.   Canvas.FillRect(0, 0, 800,600, CSSBlack);
450.   Canvas.Lighting.ActiveShader := previousShader;
451. end;
452. end.