Recent

Author Topic: Demo Scene BGRA GL Shader  (Read 13728 times)

circular

  • Hero Member
  • *****
  • Posts: 4356
    • Personal webpage
Re: Demo Scene BGRA Checker Board Shader
« Reply #15 on: July 06, 2024, 12:51:20 pm »
Hi Gigatron,

I've added a TBGLFullCanvasShader class (on dev branch), so that it is easier to make the shader. Here is the resulting BGRACheckerBoardGL class:

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(TBGLFullCanvasShader)
  16.   private
  17.     function GetTime: Single;
  18.     procedure SetTime(AValue: Single);
  19.  
  20.   protected
  21.     FTime: TUniformVariableSingle;
  22.     FColor: TUniformVariableColor;
  23.     FColorNumber: Integer;
  24.     procedure StartUse; override;
  25.     function GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string; override;
  26.  
  27.   public
  28.     constructor Create(ACanvas: TBGLCustomCanvas);
  29.     property Time: Single read GetTime write SetTime;
  30.     property ColorNumber: Integer read FColorNumber write FColorNumber;
  31.  
  32.   end;
  33.  
  34. implementation
  35.  
  36. { TBGLCheckerBoardShader }
  37.  
  38. function TBGLCheckerBoardShader.GetTime: Single;
  39. begin
  40.   result := FTime.Value;
  41. end;
  42.  
  43. procedure TBGLCheckerBoardShader.SetTime(AValue: Single);
  44. begin
  45.   FTime.Value := AValue;
  46. end;
  47.  
  48. constructor TBGLCheckerBoardShader.Create(ACanvas: TBGLCustomCanvas);
  49. begin
  50.   inherited Create(ACanvas);
  51.   FTime := UniformSingle['time'];      // float uniform
  52.   FColor := UniformColor['color'];     // color uniform
  53.  
  54.   ColorNumber := -1;  // no coloring by default
  55.   Time := 0;
  56. end;
  57.  
  58. procedure TBGLCheckerBoardShader.StartUse;
  59. begin
  60.   inherited StartUse;
  61.   FTime.Update;
  62.  
  63.   // setup custom color variable
  64.   Case ColorNumber of
  65.     0: FColor.Value := CSSRed.ToColorF(false);
  66.     1: FColor.Value := CSSYellow.ToColorF(false);
  67.     2: FColor.Value := CSSBlue.ToColorF(false);
  68.     3: FColor.Value := CSSCyan.ToColorF(false);
  69.   else
  70.     FColor.Value := BGRAWhite.ToColorF(false);
  71.   end;
  72.   FColor.Update;
  73. end;
  74.  
  75. function TBGLCheckerBoardShader.GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string;
  76. begin
  77.   result :=
  78.   'uniform float time;'#10 +
  79.   // custom color uniform variable is different from the input color from the vertices
  80.   'uniform vec4 color;'#10 +
  81.  
  82.   'void main(void)'#10 +
  83.   '{'#10 +
  84.   ' vec2 pos = '+AInputCoord+' - vec2(0.5,0.5);     '#10 +
  85.   ' float horizon = 0.0;  '#10 +
  86.   ' float fov = 0.5;      '#10 +
  87.   ' float scaling = 0.4;  '#10 +
  88.   ' vec3 p = vec3(pos.x, fov, pos.y - horizon);'#10 +
  89.   ' vec2 s = vec2(p.x/p.z, p.y/p.z) * scaling; '#10 +
  90.   ' float f = 1.0;                             '#10 +
  91.   ' //checkboard                               '#10 +
  92.   ' 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 +
  93.   ' col *= p.z*p.z*5.0*(1.0 - abs(p.x));'#10 +
  94.  
  95.   ' '+AOutputColor+' = vec4(col, col, col, 1.0) * '+AInputColor+' * color; '#10 +
  96.   '}';
  97. end;
  98.  
  99. end.

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

It's like chinese for me  :D
Yes, this seascape is quite complex. The simpler shader is easier to understand.
Conscience is the debugger of the mind

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA Checker Board Shader
« Reply #16 on: July 08, 2024, 02:50:13 pm »
Goood  !!

Thank you @circular , will test the code a.s.a.p for new shader.

Best regards

GTR
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA Checker Board Shader
« Reply #17 on: July 08, 2024, 03:55:17 pm »
Ok, @circular , here is another quick conversion based on your code ; the conversion take less time now :)

**
TBGLFullCanvasShader class (on dev branch)


Point Tunnel Shader from Flyguy
https://www.shadertoy.com/view/Xlt3R8

Projet is atached for playing with;

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,BGRADefaultShader,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.   dot_tunnel: TBGLDefaultShader;
  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.       // nothing here
  41. end;
  42.  
  43. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);
  44.  
  45. begin
  46.      dot_tunnel.Time:= dot_tunnel.Time +0.014;
  47.      dot_tunnel.RenderOnCanvas;
  48. end;
  49.  
  50. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
  51.   BGLContext: TBGLContext);
  52. begin
  53.     dot_tunnel := TBGLDefaultShader.Create(BGLContext.Canvas);
  54. end;
  55.  
  56. procedure TForm1.Timer1Timer(Sender: TObject);
  57. begin
  58.    BGLVirtualScreen1.Invalidate;
  59. end;
  60.  
  61. end.
  62.  

Shader unit ;

Code: Pascal  [Select][+][-]
  1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
  2.  
  3. { DefaultShader for any OpenGL shaders }
  4. unit BGRADefaultShader;
  5.  
  6. {$mode objfpc}{$H+}
  7.  
  8. interface
  9.  
  10. uses
  11.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
  12.  
  13. type
  14.   { Shader computing Checkerboard }
  15.   TBGLDefaultShader = class(TBGLFullCanvasShader)
  16.   private
  17.    private
  18.     function GetTime: Single;
  19.     procedure SetTime(AValue: Single);
  20.  
  21.   protected
  22.     FTime: TUniformVariableSingle;
  23.     procedure StartUse; override;
  24.     function GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string; override;
  25.  
  26.   public
  27.     constructor Create(ACanvas: TBGLCustomCanvas);
  28.     property Time: Single read GetTime write SetTime;
  29.  
  30.   end;
  31.  
  32. implementation
  33.  
  34.  
  35. { TBGLDefaultShader }
  36.  
  37. function TBGLDefaultShader.GetTime: Single;
  38. begin
  39.   result := FTime.Value;
  40. end;
  41.  
  42. procedure TBGLDefaultShader.SetTime(AValue: Single);
  43. begin
  44.   FTime.Value := AValue;
  45. end;
  46.  
  47. constructor TBGLDefaultShader.Create(ACanvas: TBGLCustomCanvas);
  48. begin
  49.   inherited Create(ACanvas);
  50.   FTime := UniformSingle['time'];      // float uniform
  51.  
  52.   Time := 0;
  53. end;
  54.  
  55. procedure TBGLDefaultShader.StartUse;
  56. begin
  57.   inherited StartUse;
  58.   FTime.Update;
  59.  
  60. end;
  61.  
  62. function TBGLDefaultShader.GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string;
  63. begin
  64.   result :=
  65.  'uniform float time;'#10+
  66.  '//Constants                          '#10 +
  67.  '#define TAU 6.2831853071795865       '#10 +
  68.  '//Parameters                         '#10 +
  69.  '#define TUNNEL_LAYERS 64             '#10 +
  70.  '#define RING_POINTS 128              '#10 +
  71.  '#define POINT_SIZE 1.8               '#10 +
  72.  '#define POINT_COLOR_A vec3(1.0)      '#10 +
  73.  '#define POINT_COLOR_B vec3(0.7)      '#10 +
  74.  '#define SPEED 0.8                    '#10 +
  75.  
  76. '//Square of x                                                                                '#10+
  77. 'float sq(float x)                                                                            '#10+
  78. '{                                                                                            '#10+
  79. '       return x*x;                                                                           '#10+
  80. '}                                                                                            '#10+
  81. '                                                                                             '#10+
  82. '//Angular repeat                                                                             '#10+
  83. 'vec2 AngRep(vec2 uv, float angle)                                                            '#10+
  84. '{                                                                                            '#10+
  85. '    vec2 polar = vec2(atan(uv.y, uv.x), length(uv));                                         '#10+
  86. '    polar.x = mod(polar.x + angle / 2.0, angle) - angle / 2.0;                               '#10+
  87. '                                                                                             '#10+
  88. '    return polar.y * vec2(cos(polar.x), sin(polar.x));                                       '#10+
  89. '}                                                                                            '#10+
  90. '                                                                                             '#10+
  91. '//Signed distance to circle                                                                  '#10+
  92. 'float sdCircle(vec2 uv, float r)                                                             '#10+
  93. '{                                                                                            '#10+
  94. '    return length(uv) - r;                                                                   '#10+
  95. '}                                                                                            '#10+
  96. '                                                                                             '#10+
  97. '//Mix a shape defined by a distance field sd with a target color using the fill       color. '#10+
  98. 'vec3 MixShape(float sd, vec3 fill, vec3 target)                                              '#10+
  99. '{                                                                                            '#10+
  100. '    float blend = smoothstep(0.0,1.0/1000.0, sd);                                            '#10+
  101. '    return mix(fill, target, blend);                                                         '#10+
  102. '}                                                                                            '#10+
  103. '                                                                                             '#10+
  104. '//Tunnel/Camera path                                                                         '#10+
  105. 'vec2 TunnelPath(float x)                                                                     '#10+
  106. '{                                                                                            '#10+
  107. '    vec2 offs = vec2(0, 0);                                                                  '#10+
  108. '                                                                                             '#10+
  109. '    offs.x = 0.2 * sin(TAU * x * 0.5) + 0.4 * sin(TAU * x * 0.2 + 0.3);                      '#10+
  110. '    offs.y = 0.3 * cos(TAU * x * 0.3) + 0.2 * cos(TAU * x * 0.1);                            '#10+
  111. '                                                                                             '#10+
  112. '    offs *= smoothstep(1.0,4.0, x);                                                          '#10+
  113. '                                                                                             '#10+
  114. '    return offs;                                                                             '#10+
  115. '}                                                                                            '#10+
  116.  
  117.  
  118.   'void main(void)'#10 +
  119.   '{'#10 +
  120.   ' vec2 uv = '+AInputCoord+' -0.5 ;     '#10 +
  121.  
  122. ' vec3 color = vec3(0);    '#10 +
  123. 'float repAngle = TAU / float(RING_POINTS);                                              '#10+
  124. 'float pointSize = POINT_SIZE/2.0/500.0;                                         '#10+
  125. '                                                                                        '#10+
  126. 'float camZ = time * SPEED;                                                             '#10+
  127. 'vec2 camOffs = TunnelPath(camZ);                                                        '#10+
  128. '                                                                                        '#10+
  129. 'for(int i = 1;i <= TUNNEL_LAYERS;i++)                                                   '#10+
  130. '{                                                                                       '#10+
  131. '    float pz = 1.0 - (float(i) / float(TUNNEL_LAYERS));                                 '#10+
  132. '                                                                                        '#10+
  133. '    //Scroll the points towards the screen                                              '#10+
  134. '    pz -= mod(camZ, 4.0 / float(TUNNEL_LAYERS));                                        '#10+
  135. '                                                                                        '#10+
  136. '    //Layer x/y offset                                                                  '#10+
  137. '    vec2 offs = TunnelPath(camZ + pz) - camOffs;                                        '#10+
  138. '                                                                                        '#10+
  139. '    //Radius of the current ring                                                        '#10+
  140. '    float ringRad = 0.15 * (1.0 / sq(pz * 0.8 + 0.4));                                  '#10+
  141. '                                                                                        '#10+
  142. '    //Only draw points when uv is close to the ring.                                    '#10+
  143. '    if(abs(length(uv + offs) - ringRad) < pointSize * 1.5)                              '#10+
  144. '    {                                                                                   '#10+
  145. '        //Angular repeated uv coords                                                    '#10+
  146. '        vec2 aruv = AngRep(uv + offs, repAngle);                                        '#10+
  147. '                                                                                        '#10+
  148. '        //Distance to the nearest point                                                 '#10+
  149. '        float pdist = sdCircle(aruv - vec2(ringRad, 0), pointSize);                     '#10+
  150. '                                                                                        '#10+
  151. '        //Stripes                                                                       '#10+
  152. '        vec3 ptColor = (mod(float(i / 2), 2.0) == 0.0) ? POINT_COLOR_A : POINT_COLOR_B; '#10+
  153. '                                                                                        '#10+
  154. '        //Distance fade                                                                 '#10+
  155. '        float shade = (1.0-pz);                                                         '#10+
  156. '                                                                                        '#10+
  157. '        color = MixShape(pdist, ptColor * shade, color);                                '#10+
  158. '    }                                                                                   '#10+
  159. '}                                                                                       '#10+
  160.  
  161. ' '+AOutputColor+' = vec4(color, 1.0)  ; '#10 +
  162. '}';
  163. end;
  164.  
  165. end.
« Last Edit: July 08, 2024, 04:02:45 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA Checker Board Shader
« Reply #18 on: July 09, 2024, 05:26:24 pm »
Hi , here is another shader example called resolution shader ; programmed under 1 hour like always ;

The goal is to interact with uniform variables with spinners ;

@circular thank you again, btw are you planning to update BGRA to include TBGLFullCanvasShader class (on dev branch) ?


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.   BGLVirtualScreen, BGRAOpenGL,BGRADefaultShader,BGRABitmapTypes,GL;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGLVirtualScreen1: TBGLVirtualScreen;
  17.     FloatSpinEdit1: TFloatSpinEdit;
  18.     FloatSpinEdit2: TFloatSpinEdit;
  19.     FloatSpinEdit3: TFloatSpinEdit;
  20.     FloatSpinEdit4: TFloatSpinEdit;
  21.     FloatSpinEdit5: TFloatSpinEdit;
  22.     Timer1: TTimer;
  23.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
  24.       BGLContext: TBGLContext);
  25.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  26.     procedure FormCreate(Sender: TObject);
  27.     procedure Timer1Timer(Sender: TObject);
  28.   private
  29.   rez_shader: TBGLDefaultShader;
  30.   public
  31.     tex  : IBGLTexture;
  32.   end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.  
  37. implementation
  38.  
  39. {$R *.lfm}
  40.  
  41. { TForm1 }
  42.  
  43. procedure TForm1.FormCreate(Sender: TObject);
  44. begin
  45.       // nothing here
  46. end;
  47.  
  48. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);
  49.  
  50. begin
  51.      rez_shader.Time:= rez_shader.Time +0.014;
  52.      rez_shader.ImageIndex:= 0;
  53.      rez_shader.Rezolution := FloatSpinEdit1.Value;
  54.      rez_shader.Scale:= FloatSpinEdit2.Value;
  55.  
  56.      rez_shader.Red  := FloatSpinEdit3.Value;
  57.      rez_shader.Green:= FloatSpinEdit4.Value;
  58.      rez_shader.Blue := FloatSpinEdit5.Value;
  59.  
  60.      rez_shader.RenderOnCanvas;
  61. end;
  62.  
  63. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
  64.   BGLContext: TBGLContext);
  65. begin
  66.     rez_shader := TBGLDefaultShader.Create(BGLContext.Canvas);
  67.     tex        := BGLTexture(ResourceFile('girls.png'));
  68. end;
  69.  
  70. procedure TForm1.Timer1Timer(Sender: TObject);
  71. begin
  72.    BGLVirtualScreen1.Invalidate;
  73. end;
  74.  
  75. end.
  76.  

Second shader unit ;

Code: Pascal  [Select][+][-]
  1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
  2.  
  3. { DefaultShader for any OpenGL shaders }
  4. unit BGRADefaultShader;
  5.  
  6. {$mode objfpc}{$H+}
  7.  
  8. interface
  9.  
  10. uses
  11.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
  12.  
  13. type
  14.   { Shader computing rez shader  }
  15.   TBGLDefaultShader = class(TBGLFullCanvasShader)
  16.   private
  17.  
  18.  
  19.   protected
  20.     FTime: TUniformVariableSingle;
  21.     FTimer : Single;
  22.  
  23.     FImageIndex: TUniformVariableInteger;
  24.     FImage_idx : integer;
  25.  
  26.     FRez: TUniformVariableSingle;
  27.     FRezolution : Single;
  28.  
  29.     FScale  : TUniformVariableSingle;
  30.     FScalev : Single;
  31.     // rgb
  32.     FRed  : TUniformVariableSingle;
  33.     FRedv : Single;
  34.  
  35.     FGreen  : TUniformVariableSingle;
  36.     FGreenv : Single;
  37.  
  38.     FBlue  : TUniformVariableSingle;
  39.     FBluev : Single;
  40.  
  41.  
  42.  
  43.     procedure StartUse; override;
  44.     function GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string; override;
  45.  
  46.   public
  47.     constructor Create(ACanvas: TBGLCustomCanvas);
  48.     // propriete lecture ecriture des uniforms
  49.     property Time: Single read FTimer write FTimer;
  50.     property ImageIndex: integer read FImage_idx write FImage_idx;
  51.  
  52.     property Rezolution:  Single read FRezolution write FRezolution;
  53.     property Scale:  Single read FScalev write FScalev;
  54.     // rgb
  55.     property Red  :  Single read FRedv write FRedv;
  56.     property Green:  Single read FGreenv write FGreenv;
  57.     property Blue :  Single read FBluev write FBluev;
  58.  
  59.  
  60.  
  61.  
  62.   end;
  63.  
  64. implementation
  65.  
  66.  
  67. { TBGLDefaultShader }
  68.  
  69.  
  70. constructor TBGLDefaultShader.Create(ACanvas: TBGLCustomCanvas);
  71. begin
  72.   inherited Create(ACanvas);
  73.   FTime := UniformSingle['time'];      // float uniform
  74.   FRez := UniformSingle['rez'];
  75.   FScale := UniformSingle['scale'];
  76.   FImageIndex := UniformInteger['image'];
  77.   FRed   := UniformSingle['red'];
  78.   FGreen := UniformSingle['green'];
  79.   FBlue  := UniformSingle['blue'];
  80.  
  81.  
  82.   FImage_idx:= 0;
  83.   FTimer := 0;
  84. end;
  85.  
  86. procedure TBGLDefaultShader.StartUse;
  87. begin
  88.   inherited StartUse;
  89.   FTime.Update;
  90.   FImageIndex.Update;
  91.   FRez.Update;
  92.   // set values to uniforms
  93.   FTime.Value:=FTimer;
  94.   FRez.Value := FRezolution;
  95.   FScale.Value:= FScalev;
  96.  
  97.   FRed.Value   := FRedv;
  98.   FGreen.Value := FGreenv;
  99.   FBlue.Value  := FBluev;
  100. end;
  101.  
  102. function TBGLDefaultShader.GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string;
  103. begin
  104.   result :=
  105.  'uniform float time;'#10+
  106.  'uniform float rez;'#10+
  107.  'uniform float scale;'#10+
  108.  'uniform sampler2D image;'#10 +
  109.  '///  RGB '#10+
  110.  'uniform float red;'#10+
  111.  'uniform float green;'#10+
  112.  'uniform float blue;'#10+
  113.  
  114.  
  115.   'void main(void)'#10 +
  116.   '{'#10 +
  117.   ' vec2 p = '+AInputCoord+'  ;     '#10 +
  118.  
  119.   'p = floor(rez*p)/rez;'#10+
  120.   'float x = 640.0*(p.y);'#10+
  121.   ''#10+
  122.  
  123.   'float cop = time*4.0;'#10+
  124.  
  125.  
  126. ' vec3 color = vec3( 0.5 + 0.5 * sin(x/scale + red - cop), 0.5 + 0.5 * cos (x/scale + green - cop), 0.5 + 0.5 * cos (x/scale + blue - cop));    '#10 +
  127. ' vec3 tx = texture2D(image,p/vec2(1.3,1.8)).xyz;'#10+
  128.  
  129.  
  130. ' '+AOutputColor+' = vec4(tx*(color*1.4)   , 1.0) ; '#10 +
  131. '}';
  132. end;
  133.  
  134. end.





Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA Checker Board Shader
« Reply #19 on: July 10, 2024, 01:44:07 am »
Hi,

And after this you can make a million of different fx with pixel shaders like this one ;

Send the example on YT quickly;

https://www.youtube.com/watch?v=RlF0pEJtjGE
 
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, BGLVirtualScreen, BGRAOpenGL, BGRADefaultShader, BGRABitmapTypes,
  10.   GL,mmsystem;
  11.  
  12. type
  13.  
  14.   { TForm1 }
  15.  
  16.   TForm1 = class(TForm)
  17.     BGLVirtualScreen1: TBGLVirtualScreen;
  18.     CheckBox1: TCheckBox;
  19.     FloatSpinEdit1: TFloatSpinEdit;
  20.     FloatSpinEdit2: TFloatSpinEdit;
  21.     FloatSpinEdit3: TFloatSpinEdit;
  22.     FloatSpinEdit4: TFloatSpinEdit;
  23.     FloatSpinEdit5: TFloatSpinEdit;
  24.     Timer1: TTimer;
  25.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
  26.       BGLContext: TBGLContext);
  27.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  28.     procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;
  29.       BGLContext: TBGLContext);
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure FormDestroy(Sender: TObject);
  32.     procedure Timer1Timer(Sender: TObject);
  33.   private
  34.   rez_shader: TBGLDefaultShader;
  35.   FWavStream : TMemoryStream;
  36.   public
  37.     tex  : IBGLTexture;
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.   r_md : single;
  43.  
  44. implementation
  45.  
  46. {$R *.lfm}
  47.  
  48. { TForm1 }
  49.  
  50. procedure TForm1.FormCreate(Sender: TObject);
  51. begin
  52.       r_md :=0;
  53.       // audio stream
  54.   FWavStream    := TMemoryStream.Create;
  55.   FWavStream.LoadFromFile('outlander.wav');
  56.   PlaySound(FWavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY);
  57.  
  58. end;
  59.  
  60. procedure TForm1.FormDestroy(Sender: TObject);
  61. begin
  62.   PlaySound(nil, 0, 0);
  63.   FWavStream.Free;
  64. end;
  65.  
  66. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);
  67.  
  68. begin
  69.      rez_shader.Time:= rez_shader.Time +0.014;
  70.      rez_shader.ImageIndex:= 0;
  71.      rez_shader.Rezolution := FloatSpinEdit1.Value;
  72.      rez_shader.Scale:= FloatSpinEdit2.Value;
  73.  
  74.      rez_shader.Red  := FloatSpinEdit3.Value;
  75.      rez_shader.Green:= FloatSpinEdit4.Value;
  76.      rez_shader.Blue := FloatSpinEdit5.Value;
  77.  
  78.      rez_shader.RainbowMode :=r_md;
  79.  
  80.      rez_shader.RenderOnCanvas;
  81. end;
  82.  
  83. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
  84.   BGLContext: TBGLContext);
  85. begin
  86.   tex   := nil;
  87.   FreeAndNil(rez_shader);
  88. end;
  89.  
  90. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
  91.   BGLContext: TBGLContext);
  92. begin
  93.     rez_shader := TBGLDefaultShader.Create(BGLContext.Canvas);
  94.     tex        := BGLTexture(ResourceFile('louie.png'));
  95. end;
  96.  
  97. procedure TForm1.Timer1Timer(Sender: TObject);
  98. begin
  99.    if(CheckBox1.Checked) then r_md := 1.0
  100.    else
  101.    r_md := 0.0;
  102.    BGLVirtualScreen1.Invalidate;
  103. end;
  104.  
  105. end.
  106.  

Shader unit

Code: Pascal  [Select][+][-]
  1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
  2.  
  3. { DefaultShader for any OpenGL shaders }
  4. unit BGRADefaultShader;
  5.  
  6. {$mode objfpc}{$H+}
  7.  
  8. interface
  9.  
  10. uses
  11.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
  12.  
  13. type
  14.   { Shader computing rez shader  }
  15.   TBGLDefaultShader = class(TBGLFullCanvasShader)
  16.   private
  17.  
  18.  
  19.   protected
  20.     FTime: TUniformVariableSingle;
  21.     FTimer : Single;
  22.  
  23.     FImageIndex: TUniformVariableInteger;
  24.     FImage_idx : Integer;
  25.  
  26.     F_RainMode  : TUniformVariableSingle;
  27.     F_RainModev : single;
  28.  
  29.  
  30.     FRez: TUniformVariableSingle;
  31.     FRezolution : Single;
  32.  
  33.     FScale  : TUniformVariableSingle;
  34.     FScalev : Single;
  35.     // rgb
  36.     FRed  : TUniformVariableSingle;
  37.     FRedv : Single;
  38.  
  39.     FGreen  : TUniformVariableSingle;
  40.     FGreenv : Single;
  41.  
  42.     FBlue  : TUniformVariableSingle;
  43.     FBluev : Single;
  44.  
  45.  
  46.  
  47.     procedure StartUse; override;
  48.     function GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string; override;
  49.  
  50.   public
  51.     constructor Create(ACanvas: TBGLCustomCanvas);
  52.     // propriete lecture ecriture des uniforms
  53.     property Time: Single read FTimer write FTimer;
  54.     property ImageIndex: integer read FImage_idx write FImage_idx;
  55.  
  56.     property RainbowMode: single read F_RainModev write F_RainModev;
  57.  
  58.     property Rezolution:  Single read FRezolution write FRezolution;
  59.     property Scale:  Single read FScalev write FScalev;
  60.     // rgb
  61.     property Red  :  Single read FRedv write FRedv;
  62.     property Green:  Single read FGreenv write FGreenv;
  63.     property Blue :  Single read FBluev write FBluev;
  64.  
  65.  
  66.  
  67.  
  68.   end;
  69.  
  70. implementation
  71.  
  72.  
  73. { TBGLDefaultShader }
  74.  
  75.  
  76. constructor TBGLDefaultShader.Create(ACanvas: TBGLCustomCanvas);
  77. begin
  78.   inherited Create(ACanvas);
  79.   FTime := UniformSingle['time'];      // float uniform
  80.   FRez := UniformSingle['rez'];
  81.   FScale := UniformSingle['scale'];
  82.   FImageIndex := UniformInteger['image'];
  83.   FRed   := UniformSingle['red'];
  84.   FGreen := UniformSingle['green'];
  85.   FBlue  := UniformSingle['blue'];
  86.   // rainbow mode 0/1
  87.   F_RainMode := UniformSingle['r_mode'];
  88.  
  89.   FImage_idx:= 0;
  90.   FTimer := 0;
  91.   RainbowMode :=0;
  92. end;
  93.  
  94. procedure TBGLDefaultShader.StartUse;
  95. begin
  96.   inherited StartUse;
  97.   FTime.Update;
  98.   FImageIndex.Update;
  99.   FRez.Update;
  100.   // set values to uniforms
  101.   FTime.Value:=FTimer;
  102.   FRez.Value := FRezolution;
  103.   FScale.Value:= FScalev;
  104.  
  105.   FRed.Value       := FRedv;
  106.   FGreen.Value     := FGreenv;
  107.   FBlue.Value      := FBluev;
  108.   F_RainMode.Value := F_RainModev;
  109.  
  110. end;
  111.  
  112. function TBGLDefaultShader.GetFragmentShader(AInputCoord, AInputColor, ACanvasSize, AOutputColor: string): string;
  113. begin
  114.   result :=
  115.  'uniform float time;'#10+
  116.  'uniform float rez;'#10+
  117.  'uniform float scale;'#10+
  118.  'uniform sampler2D image;'#10 +
  119.  '///  RGB '#10+
  120.  'uniform float red;'#10+
  121.  'uniform float green;'#10+
  122.  'uniform float blue;'#10+
  123.  'uniform float r_mode;'#10+
  124.  
  125.   'void main(void)'#10 +
  126.   '{'#10 +
  127.   ' vec2 p = '+AInputCoord+'  ;     '#10 +
  128.  
  129.   'p = floor(rez*p)/rez;'#10+
  130.   'float x = 640.0*(p.y);'#10+
  131.   ''#10+
  132.  
  133.   'float cop = time*4.0;'#10+
  134.  
  135.  
  136. ' vec3 color = vec3( 0.5 + 0.5 * sin(x/scale + red - cop), 0.5 + 0.5 * cos (x/scale + green - cop), 0.5 + 0.5 * cos (x/scale + blue - cop));    '#10 +
  137. ' vec3 tx = texture2D(image,p/vec2(1.6,1.0)).xyz;'#10+
  138. ' if(r_mode==0.0)'#10+
  139. '{'#10+
  140. ' ' +AOutputColor+' = vec4(tx, 1.0);'#10+
  141. '}'#10+
  142.  
  143. ' if(r_mode==1.0)'#10+
  144. '{'#10+
  145. ' ' +AOutputColor+' = vec4(tx+(color+(tx.r*tx.g*tx.b))/2.0 , 1.0);'#10+
  146. '}'#10+
  147.  
  148. '}';
  149. end;
  150.  
  151. end.


« Last Edit: July 10, 2024, 02:00:55 am by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

circular

  • Hero Member
  • *****
  • Posts: 4356
    • Personal webpage
Re: Demo Scene BGRA Checker Board Shader
« Reply #20 on: July 11, 2024, 12:15:17 am »
Hi Gigatron,

I am not home, but passing by and well seems that shaders open up limitless possibilities!
Conscience is the debugger of the mind

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA GL Shader
« Reply #21 on: July 14, 2024, 08:35:51 am »
Hi,

Here a video of mixed shaders with BGRA component one with starfield and other with texture display on the same BGLscreen ;

Enjoy ;

https://www.youtube.com/watch?v=8hn1dtAGEMA
Sub Quantum Technology ! Gigatron 68000 Colmar France;

circular

  • Hero Member
  • *****
  • Posts: 4356
    • Personal webpage
Re: Demo Scene BGRA GL Shader
« Reply #22 on: July 15, 2024, 06:21:54 pm »
Very nice indeed!
Conscience is the debugger of the mind

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA GL Shader
« Reply #23 on: July 15, 2024, 07:14:36 pm »
Very nice indeed!

Thank you @circular

Since we lost the football match I no longer feel good :)

So let's start another projet based on an old shader i ve made , gradient map or color map;
here is the quickly coded source: Gfx pic from (Mosterv)

Edit : Work nice with colorpicker selector now :

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, BGRABitmapTypes,
  10.   BGRAGraphicControl;
  11.  
  12. type
  13.  
  14.   { TForm1 }
  15.  
  16.   TForm1 = class(TForm)
  17.     BGLVirtualScreen1: TBGLVirtualScreen;
  18.     Button1: TButton;
  19.     Button2: TButton;
  20.     Button3: TButton;
  21.     CheckBox1: TCheckBox;
  22.     CheckBox2: TCheckBox;
  23.     ColorDialog1: TColorDialog;
  24.     Timer1: TTimer;
  25.     procedure BGLVirtualScreen1LoadTextures(Sender: TObject;
  26.       BGLContext: TBGLContext);
  27.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  28.     procedure BGLVirtualScreen1UnloadTextures(Sender: TObject;
  29.       BGLContext: TBGLContext);
  30.     procedure Button1Click(Sender: TObject);
  31.     procedure Button2Click(Sender: TObject);
  32.     procedure Button3Click(Sender: TObject);
  33.  
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure FormDestroy(Sender: TObject);
  36.     procedure Timer1Timer(Sender: TObject);
  37.   private
  38.  
  39.     cmap_shader: TBGLCMapShader;
  40.  
  41.   public
  42.    tex,gl_surface  : IBGLTexture;
  43.    debug_mode,cmap_on : single;
  44.    rred,rgreen,rblue : TColor;
  45.    gred,ggreen,gblue : TColor;
  46.    bred,bgreen,bblue : TColor;
  47.  
  48.   end;
  49.  
  50. var
  51.   Form1: TForm1;
  52.  
  53. implementation
  54.  
  55. {$R *.lfm}
  56.  
  57. { TForm1 }
  58.  
  59. procedure TForm1.FormCreate(Sender: TObject);
  60. begin
  61.     debug_mode := 0.0;
  62.     cmap_on    := 0.0;
  63. end;
  64.  
  65. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
  66.   BGLContext: TBGLContext);
  67. begin
  68.     gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
  69.     tex     := BGLTexture(ResourceFile('mosterv.png'));
  70.     cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);
  71. end;
  72.  
  73. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
  74.   BGLContext: TBGLContext);
  75.  
  76. begin
  77.     // le traitement du sampler2D comme texture
  78.      cmap_shader.ImageIndex:= 0;
  79.      cmap_shader.Debug:=debug_mode;
  80.      cmap_shader.Cmap:= cmap_on;
  81.      cmap_shader.RedColor   := BGRA(rred,rgreen,rblue).ToColorF(false);
  82.      cmap_shader.GreenColor := BGRA(gred,ggreen,gblue).ToColorF(false);
  83.      cmap_shader.BlueColor  := BGRA(bred,bgreen,bblue).ToColorF(false);
  84.      gl_surface := cmap_shader.Render(tex);        // container de l'image affichee par le shader
  85.      BGLContext.Canvas.PutImage(0,0, gl_surface,BGRA(255,255,255,255)); // le shader surface
  86.  
  87. end;
  88.  
  89. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
  90.   BGLContext: TBGLContext);
  91. begin
  92.   tex   := nil;
  93.   gl_surface := nil;
  94.   FreeAndNil(cmap_shader);
  95. end;
  96.  
  97. procedure TForm1.Button1Click(Sender: TObject);
  98.   var
  99.   SelectedColor: TColor;
  100.   RedComponent: Byte;
  101.   GreenComponent : Byte;
  102.   BlueComponent : Byte;
  103.  
  104. begin
  105.    if ColorDialog1.Execute then
  106.     SelectedColor := ColorDialog1.Color;
  107.     RedComponent := Red(SelectedColor);
  108.     GreenComponent := Green(SelectedColor);
  109.     BlueComponent := Blue(SelectedColor);
  110.  
  111.     rred    := RedComponent;
  112.     rgreen  := GreenComponent;
  113.     rblue   := BlueComponent ;
  114.  
  115.  
  116. end;
  117.  
  118. procedure TForm1.Button2Click(Sender: TObject);
  119.   var
  120.    SelectedColor: TColor;
  121.    RedComponent: Byte;
  122.    GreenComponent : Byte;
  123.    BlueComponent : Byte;
  124.  
  125.  begin
  126.     if ColorDialog1.Execute then
  127.      SelectedColor := ColorDialog1.Color;
  128.      RedComponent := Red(SelectedColor);
  129.      GreenComponent := Green(SelectedColor);
  130.      BlueComponent := Blue(SelectedColor);
  131.  
  132.      gred    := RedComponent;
  133.      ggreen  := GreenComponent;
  134.      gblue   := BlueComponent ;
  135.  
  136. end;
  137.  
  138. procedure TForm1.Button3Click(Sender: TObject);
  139.   var
  140.     SelectedColor: TColor;
  141.     RedComponent: Byte;
  142.     GreenComponent : Byte;
  143.     BlueComponent : Byte;
  144.  
  145.   begin
  146.      if ColorDialog1.Execute then
  147.       SelectedColor := ColorDialog1.Color;
  148.       RedComponent := Red(SelectedColor);
  149.       GreenComponent := Green(SelectedColor);
  150.       BlueComponent := Blue(SelectedColor);
  151.  
  152.       bred    := RedComponent;
  153.       bgreen  := GreenComponent;
  154.       bblue   := BlueComponent ;
  155.  
  156. end;
  157.  
  158. procedure TForm1.FormDestroy(Sender: TObject);
  159. begin
  160.  
  161. end;
  162.  
  163. procedure TForm1.Timer1Timer(Sender: TObject);
  164. begin
  165.     // debug draw gradient color
  166.      if(CheckBox1.Checked) then debug_mode :=1.0
  167.      else
  168.      debug_mode := 0.0;
  169.  
  170.      if(CheckBox2.Checked) then cmap_on :=1.0
  171.      else
  172.      cmap_on := 0.0;
  173.  
  174.      BGLVirtualScreen1.Invalidate;
  175. end;
  176.  
  177. end.
  178.  
  179.  

Cmap shader unit ;

Code: Pascal  [Select][+][-]
  1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
  2.  
  3. { Colormap OpenGL shader }
  4. unit BGRACMapShader;
  5.  
  6. {$mode objfpc}{$H+}
  7.  
  8. interface
  9.  
  10. uses
  11.   BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
  12.  
  13. type
  14.   { ColorMap Shader computing rez shader  }
  15.   TBGLCMapShader = class(TBGLShader3D)
  16.  
  17.   private
  18.  
  19.   protected
  20.     FTime: TUniformVariableSingle;
  21.     FTimer : Single;
  22.  
  23.     FImageIndex: TUniformVariableInteger;
  24.     FImage_idx : Integer;
  25.  
  26.     FDebug: TUniformVariableSingle;
  27.     FDebugV : Single;
  28.  
  29.     FCmap : TUniformVariableSingle;
  30.     FCmapV : Single;
  31.  
  32.  
  33.     // colors
  34.     FRColor: TUniformVariableColor;
  35.     FRColorV : TColorF;
  36.  
  37.     FGColor: TUniformVariableColor;
  38.     FGColorV : TColorF;
  39.  
  40.     FBColor: TUniformVariableColor;
  41.     FBColorV : TColorF;
  42.  
  43.     procedure StartUse; override;
  44.  
  45.   public
  46.  
  47.     constructor Create(ACanvas: TBGLCustomCanvas);
  48.     function Render(ATexture: IBGLTexture): IBGLTexture; overload;
  49.     // propriete lecture ecriture des uniforms
  50.     property Time: Single read FTimer write FTimer;
  51.     property ImageIndex: integer read FImage_idx write FImage_idx;
  52.  
  53.     property RedColor : TColorF read FRColorV write FRColorV;
  54.     property GreenColor : TColorF read FGColorV write FGColorV;
  55.     property BlueColor : TColorF read FBColorV write FBColorV;
  56.  
  57.     property Debug:  Single read FDebugV write FDebugV;
  58.  
  59.     property Cmap:  Single read FCmapV write FCmapV;
  60.  
  61.  
  62.  
  63.   end;
  64.  
  65. implementation
  66.  
  67. { TBGLCMapShader }
  68.  
  69. constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas);
  70.  
  71. begin
  72. // vertex + fragment
  73. inherited Create(ACanvas,
  74. 'void main(void) {'#10 +
  75. '    gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +
  76. '    texCoord = vec2(gl_MultiTexCoord0);'#10 +
  77. '}',
  78.  
  79. 'out vec4 FragmentColor;'#10 +
  80. 'uniform float time;'#10+
  81. 'uniform float dbg;'#10+
  82. 'uniform sampler2D image;'#10+
  83. 'uniform float demo_mode;'#10+
  84. 'uniform float c_map;'#10+
  85.  
  86. 'uniform vec4 r_color;'#10 +
  87. 'uniform vec4 g_color;'#10 +
  88. 'uniform vec4 b_color;'#10 +
  89.  
  90. '// G Map        '#10+
  91. 'vec3 gmixer(vec3 c1, vec3 c2, vec3 c3, float g)'#10+
  92. '{'#10+
  93. '     vec3 fmx = mix(c1, c3, g);             '#10+
  94. '     float u = 1.0 - abs(g * 2.0 - 1.0);    '#10+
  95. '     fmx = mix(fmx, c2, u);                 '#10+
  96. '   return fmx;                              '#10+
  97. '}   '#10+
  98.  
  99.  
  100.  
  101. 'void main(void)'#10 +
  102. '{'#10 +
  103. 'vec2 p = texCoord ;     '#10+
  104. // flip y
  105. 'p.y = 1.-p.y;'#10+
  106. '//p = floor(256.0*p)/256.0;'#10+
  107.  
  108. // depuis qu'on a perdu au foot j'ai plus la peche !!!
  109.  
  110. 'vec4 tex = texture2D(image,p);'#10+
  111. 'float l = dot(tex.rgb, vec3(0.299, 0.587, 0.114));'#10+
  112.  
  113. 'vec3 c1 = vec3(r_color);'#10+
  114. 'vec3 c2 = vec3(g_color);'#10+
  115. 'vec3 c3 = vec3(b_color);'#10+
  116.  
  117. 'vec4 map  = vec4(0.0,0.0,0.0,1.0);'#10+
  118. 'map = vec4(mix(tex.xyz,gmixer(c1, c2, c3, l),1.0),1.0);'#10+
  119.  
  120. 'if(c_map != 0.0 )'#10+
  121. 'FragmentColor = vec4(map);'#10+
  122. 'else'#10+
  123. 'FragmentColor = vec4(tex);'#10+
  124.  
  125. // debug gradient
  126. 'if(dbg != 0.0 )'#10+
  127. '{'#10+
  128. '   if(p.y > 0.90){'#10+
  129. '    FragmentColor = vec4( gmixer(c1, c2, c3, 2.*p.x-0.3 ) , 1.0);'#10+
  130. '   }'#10+
  131. '}'#10+
  132.  
  133. '}',
  134.  
  135. 'varying vec2 texCoord;', '130');
  136.  
  137.   FTime := UniformSingle['time'];      // float uniform
  138.   FDebug := UniformSingle['dbg'];
  139.   FCmap := UniformSingle['c_map'];
  140.  
  141.   FImageIndex := UniformInteger['image'];
  142.  
  143.   FRColor := UniformColor['r_color'];
  144.   FGColor := UniformColor['g_color'];
  145.   FBColor := UniformColor['b_color'];
  146.  
  147.   FImage_idx:= 0;
  148.   FTimer := 0;
  149.   FDebugV :=1.0;
  150. end;
  151.  
  152.  
  153. procedure TBGLCMapShader.StartUse;
  154. begin
  155.   inherited StartUse;
  156.   FTime.Update;
  157.   FImageIndex.Update;
  158.  
  159.   // set values to uniforms
  160.   FTime.Value:=FTimer;
  161.  
  162.  // FRColor.Update;
  163.   FRColor.Value:=FRColorV;
  164.  // FGColor.Update;
  165.   FGColor.Value:=FGColorV;
  166.  // FBColor.Update;
  167.   FBColor.Value:=FBColorV;
  168.   // Debug pour montrer le gradien
  169.  //  FDebug.Update;
  170.    FDebug.Value:= FDebugV;
  171.  
  172.    FCmap.Value:= FCmapV;
  173.  
  174. end;
  175.  
  176. function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;
  177. var previousBuf,buf: TBGLCustomFrameBuffer;
  178.   previousShader: TBGLCustomShader;
  179. begin
  180.   previousBuf := Canvas.ActiveFrameBuffer;
  181.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
  182.   Canvas.ActiveFrameBuffer := buf;
  183.   Canvas.Fill(BGRAPixelTransparent);
  184.   previousShader := Canvas.Lighting.ActiveShader;
  185.   Canvas.Lighting.ActiveShader := self;
  186.   ATexture.Draw(0, 0);
  187.   Canvas.Lighting.ActiveShader := previousShader;
  188.   Canvas.ActiveFrameBuffer := previousBuf;
  189.   result := buf.MakeTextureAndFree;
  190. end;
  191.  
  192. end.





« Last Edit: July 15, 2024, 08:55:11 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

circular

  • Hero Member
  • *****
  • Posts: 4356
    • Personal webpage
Re: Demo Scene BGRA GL Shader
« Reply #24 on: July 15, 2024, 09:45:45 pm »
I sympathize with your sadness. And I understand how programming can be comforting.  :)  I am somehow happy for the winners anyway.
Conscience is the debugger of the mind

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA GL Shader
« Reply #25 on: July 17, 2024, 10:24:04 pm »
Hi,
Let's share another nice shader;

Live version on construct2 version :
http://gigatron3k.free.fr/html5/C2/FX/dispersion/

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, BGRACMapShader, BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGLVirtualScreen1: TBGLVirtualScreen;
  17.     FloatSpinEdit1: TFloatSpinEdit;
  18.     FloatSpinEdit2: 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.     cmap_shader: TBGLCMapShader;
  30.   public
  31.    texture,gl_surface : IBGLTexture;
  32.    fnt : IBGLFont;
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.  
  38. implementation
  39.  
  40. {$R *.lfm}
  41.  
  42. { TForm1 }
  43.  
  44. procedure TForm1.FormCreate(Sender: TObject);
  45. begin
  46.    fnt := BGLFont('Arial',30);
  47. end;
  48.  
  49.  
  50. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
  51.   BGLContext: TBGLContext);
  52.  
  53. begin
  54.     gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
  55.     texture     := BGLTexture(ResourceFile('girl5.png'));
  56.     cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);
  57.  
  58. end;
  59.  
  60. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
  61.   BGLContext: TBGLContext);
  62.  
  63. begin
  64.     // le traitement du sampler2D comme texture
  65.    // cmap_shader.ImageIndex:= 0;
  66.      gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader
  67.      cmap_shader.Render(texture);
  68.      BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image de miss marvel
  69.      fnt.TextOut(160,560,'BGRA GL DISPERSION SHADER');
  70. end;
  71.  
  72. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
  73.   BGLContext: TBGLContext);
  74. begin
  75.   // libere et vire tout !!
  76.  
  77.   texture    := nil;
  78.   gl_surface := nil;
  79.   FreeAndNil(cmap_shader);
  80. end;
  81.  
  82.  
  83. procedure TForm1.FormDestroy(Sender: TObject);
  84. begin
  85.  
  86. end;
  87.  
  88. procedure TForm1.Timer1Timer(Sender: TObject);
  89. begin
  90.     cmap_shader.Time   := cmap_shader.Time + FloatSpinEdit1.value/1000;
  91.     cmap_shader.Factor := FloatSpinEdit2.value;
  92.     BGLVirtualScreen1.Invalidate;
  93. end;
  94.  
  95. end.
  96.  

Modifyed CMAP shader

Code: Pascal  [Select][+][-]
  1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
  2.  
  3. { Hue X/Y Shift OpenGL shader }
  4. unit BGRACMapShader;
  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.   TBGLCMapShader = 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 TBGLCMapShader.GetCanvasSize: TPointF;
  52. begin
  53.   result := FCanvasSize.Value;
  54. end;
  55.  
  56. procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);
  57. begin
  58.   FCanvasSize.Value := AValue;
  59. end;
  60.  
  61.  
  62. { TBGLCMapShader }
  63.  
  64. constructor TBGLCMapShader.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. '#define PI 3.141592653589793238'#10+
  78. 'out vec4 FragmentColor;'#10 +
  79. 'uniform float time;'#10+
  80. 'uniform float fct;'#10+
  81. 'uniform sampler2D image;'#10+
  82.  
  83. 'void main()'#10 +
  84. '{'#10 +
  85. 'vec2 uv =  texCoord.xy   ;                                   '#10+
  86. // flip y
  87. '   uv.y = 1.-uv.y;                                           '#10+
  88. // resolution down
  89. 'uv = floor(512.0*uv)/512.0;'#10+
  90. // move texture
  91. 'vec2  xy = vec2(0.01,0.40);'#10+
  92.  
  93. 'vec4 d,p = gl_FragColor-gl_FragColor;'#10+
  94. 'for(float i = 0.; i < 10.0; i++) {                                              '#10+
  95. '  p = vec4(i/10.,6.8*pow((1.0-i/10.)*i/10.0,1.5),1.-i/10.,1);                   '#10+
  96. '  d += p*p;                                                                     '#10+
  97. '  vec2 m = vec2(.05,.3);                                                        '#10+
  98. '  gl_FragColor += p*p*texture2D(image, uv-xy+i/10.*.05*(pow(sin(uv*10.0+3.*time),   '#10+
  99. '  vec2(3.))+fct*texture2D(image, uv-xy).xy-.2));                             '#10+
  100. '}                                                                         '#10+
  101. '   gl_FragColor = smoothstep(0.,1.,gl_FragColor/d);'#10+
  102.  
  103.  
  104. '}',
  105. 'varying vec2 texCoord;', '130');
  106.  
  107.   FTime := UniformSingle['time'];      // float uniform
  108.   FFact := UniformSingle['fct']; ;
  109.  
  110.   FImageIndex := UniformInteger['image'];
  111.   FCanvasSize := UniformPointF['canvasSize'];
  112.   FImage_idx:= 0;
  113.   FTimer := 0;
  114.   FFactV := 0;
  115. end;
  116.  
  117. procedure TBGLCMapShader.StartUse;
  118. begin
  119.   inherited StartUse;
  120.   FTime.Update;
  121.   FTime.Value:=FTimer;
  122.   FImageIndex.Update;
  123.   // set values to uniforms
  124.  
  125.   FFact.Update;
  126.   FFact.Value:= FFactV;
  127.   FCanvasSize.Update;
  128.  
  129. end;
  130.  
  131. function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;
  132. var previousBuf,buf: TBGLCustomFrameBuffer;
  133.   previousShader: TBGLCustomShader;
  134. begin
  135.   previousBuf := Canvas.ActiveFrameBuffer;
  136.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
  137.   Canvas.ActiveFrameBuffer := buf;
  138.   Canvas.Fill(BGRAPixelTransparent);
  139.   previousShader := Canvas.Lighting.ActiveShader;
  140.   Canvas.Lighting.ActiveShader := self;
  141.   ATexture.Draw(0, 0);
  142.   Canvas.Lighting.ActiveShader := previousShader;
  143.   Canvas.ActiveFrameBuffer := previousBuf;
  144.   result := buf.MakeTextureAndFree;
  145.  
  146.   // canvas renderer
  147.   //previousBuf := Canvas.ActiveFrameBuffer;
  148.   //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
  149.   //Canvas.ActiveFrameBuffer := buf;
  150.   //Canvas.Fill(BGRAPixelTransparent);
  151.   //RenderOnCanvas;
  152.   //Canvas.ActiveFrameBuffer := previousBuf;
  153.   //result := buf.MakeTextureAndFree;
  154.  
  155. end;
  156.  
  157. procedure TBGLCMapShader.RenderOnCanvas;
  158. var
  159.   previousShader: TBGLCustomShader;
  160. begin
  161.   previousShader := Canvas.Lighting.ActiveShader;
  162.   Canvas.Lighting.ActiveShader := self;
  163.   CanvasSize := PointF(800,600);
  164.   Canvas.FillRect(0, 0, 800,600, CSSWhite);
  165.   Canvas.Lighting.ActiveShader := previousShader;
  166. end;
  167. end.

* Edit ; just add x_displacement instead XY ;

Code: Pascal  [Select][+][-]
  1. '  gl_FragColor += p*p*texture2D(image, uv-xy+i/10.*.05*(pow(sin(uv*10.0+3.*time),   '#10+
  2. '  vec2(3.))+fct*texture2D(image, uv-xy).xy-.2));                             '#10+
  3.  
  4. // replace it with
  5.  
  6. '  gl_FragColor += p*p*texture2D(image, uv-xy+i/10.*.05*(pow(sin(uv*10.0+3.*time),   '#10+
  7. '  vec2(3.))-vec2(fct,0.0)*texture2D(image, uv-xy).xy-.2));                             '#10+
  8.  
  9.  
« Last Edit: July 17, 2024, 10:50:15 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA GL Shader
« Reply #26 on: July 18, 2024, 11:48:25 pm »
Hi
Another nice Shader From KALI (Star Nest by Pablo Roman Andrioli License: MIT )

https://www.shadertoy.com/view/XlfGRj

Converted in five minutes to BGRA GL shader;

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, BGRACMapShader, BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGLVirtualScreen1: TBGLVirtualScreen;
  17.     FloatSpinEdit1: TFloatSpinEdit;
  18.     FloatSpinEdit2: 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.     cmap_shader: TBGLCMapShader;
  30.   public
  31.    texture,gl_surface : IBGLTexture;
  32.    fnt : IBGLFont;
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.  
  38. implementation
  39.  
  40. {$R *.lfm}
  41.  
  42. { TForm1 }
  43.  
  44. procedure TForm1.FormCreate(Sender: TObject);
  45. begin
  46.    fnt := BGLFont('Arial',30);
  47. end;
  48.  
  49.  
  50. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
  51.   BGLContext: TBGLContext);
  52.  
  53. begin
  54.     gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
  55.     texture     := BGLTexture(ResourceFile('girl5.png'));
  56.     cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);
  57.  
  58. end;
  59.  
  60. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
  61.   BGLContext: TBGLContext);
  62.  
  63. begin
  64.     // le traitement du sampler2D comme texture
  65.      cmap_shader.Rezolution:= 1024.0;
  66.      //gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader
  67.      //BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image
  68.  
  69.      // shader without texture ; canvas renderer
  70.      cmap_shader.RenderOnCanvas;
  71.  
  72.      fnt.TextOut(60,560,'BGRA GL STAR NEST SHADER FROM KALI');
  73. end;
  74.  
  75. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
  76.   BGLContext: TBGLContext);
  77. begin
  78.   // libere et vire tout !!
  79.  
  80.   texture    := nil;
  81.   gl_surface := nil;
  82.   FreeAndNil(cmap_shader);
  83. end;
  84.  
  85.  
  86. procedure TForm1.FormDestroy(Sender: TObject);
  87. begin
  88.  
  89. end;
  90.  
  91. procedure TForm1.Timer1Timer(Sender: TObject);
  92. begin
  93.     cmap_shader.Time   := cmap_shader.Time + FloatSpinEdit1.value/1000;
  94.     cmap_shader.Factor := FloatSpinEdit2.value;
  95.     BGLVirtualScreen1.Invalidate;
  96. end;
  97.  
  98. end.
  99.  

Star nest shader;

Code: Pascal  [Select][+][-]
  1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
  2.  
  3. { Hue X/Y Shift OpenGL shader }
  4. unit BGRACMapShader;
  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.   TBGLCMapShader = 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.     FRez: TUniformVariableSingle;
  30.     FRezV : Single;
  31.  
  32.     FImageIndex: TUniformVariableInteger;
  33.     FImage_idx : 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 Factor: Single read FFactV write FFactV;
  46.  
  47.     property Rezolution:  Single read FRezV write FRezV;
  48.  
  49.     property ImageIndex: integer read FImage_idx write FImage_idx;
  50.     property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
  51.  
  52.  
  53.   end;
  54.  
  55. implementation
  56.  
  57. function TBGLCMapShader.GetCanvasSize: TPointF;
  58. begin
  59.   result := FCanvasSize.Value;
  60. end;
  61.  
  62. procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);
  63. begin
  64.   FCanvasSize.Value := AValue;
  65. end;
  66.  
  67.  
  68. { TBGLCMapShader }
  69.  
  70. constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas);
  71.  
  72. begin
  73. // vertex + fragment
  74. inherited Create(ACanvas,
  75. 'uniform vec2 canvasSize;'#10 +
  76. 'void main(void) {'#10 +
  77. ' gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +
  78. '  gl_FrontColor = gl_Color;'#10 +
  79. ' texCoord = gl_Vertex.xy / canvasSize;'#10 +
  80. ' // texCoord = vec2(gl_MultiTexCoord0);'#10 +
  81. '}',
  82.  
  83. // Star Nest by Pablo Roman Andrioli
  84. // License: MIT
  85.  
  86. '#define iterations 16        '#10+
  87. '#define formuparam 0.53      '#10+
  88. '#define volsteps 20          '#10+
  89. '#define stepsize 0.1         '#10+
  90. '#define zoom   0.800         '#10+
  91. '#define tile   0.850         '#10+
  92. '#define speed  0.010         '#10+
  93. '#define brightness 0.0015    '#10+
  94. '#define darkmatter 0.300     '#10+
  95. '#define distfading 0.730     '#10+
  96. '#define saturation 0.850     '#10+
  97.  
  98. 'out vec4 FragmentColor;'#10 +
  99. 'uniform float time;'#10+
  100. 'uniform float fct;'#10+
  101. 'uniform float rez;'#10+
  102. 'uniform sampler2D image;'#10+
  103.  
  104. 'void main()'#10 +
  105. '{'#10 +
  106. 'vec2 uv =  texCoord.xy   ;                                   '#10+
  107. // flip y
  108. '   uv.y = 1.-uv.y;                                           '#10+
  109. // resolution down
  110. 'uv = floor(rez*uv)/rez;                                      '#10+
  111. // move texture
  112. 'vec2  xy = vec2(0.0,0.40);                                   '#10+
  113. '//uv.y*=800./600.0;                                                    '#10+
  114. '       vec3 dir=vec3(uv*zoom,1.);                                                     '#10+
  115. '       float tm=time*speed+.25;                                                    '#10+
  116.  
  117. '       float a1=.5;                                                                   '#10+
  118. '       float a2=.8;                                                                   '#10+
  119. '       mat2 rot1=mat2(cos(a1),sin(a1),-sin(a1),cos(a1));                              '#10+
  120. '       mat2 rot2=mat2(cos(a2),sin(a2),-sin(a2),cos(a2));                              '#10+
  121. '       dir.xz*=rot1;                                                                  '#10+
  122. '       dir.xy*=rot2;                                                                  '#10+
  123. '       vec3 from=vec3(1.,.5,0.5);                                                     '#10+
  124. '       from+=vec3(tm,0,-2.);                                                        '#10+
  125. '       from.xz*=rot1;                                                                 '#10+
  126. '       from.xy*=rot2;                                                                 '#10+
  127. '                                                                                      '#10+
  128. '       //volumetric rendering                                                         '#10+
  129. '       float s=0.1,fade=1.;                                                           '#10+
  130. '       vec3 v=vec3(0.);                                                               '#10+
  131. '       for (int r=0; r<volsteps; r++) {                                               '#10+
  132. '               vec3 p=from+s*dir*.5;                                                  '#10+
  133. '               p = abs(vec3(tile)-mod(p,vec3(tile*2.))); // tiling fold               '#10+
  134. '               float pa,a=pa=0.;                                                      '#10+
  135. '               for (int i=0; i<iterations; i++) {                                     '#10+
  136. '                       p=abs(p)/dot(p,p)-formuparam; // the magic formula             '#10+
  137. '                       a+=abs(length(p)-pa); // absolute sum of average change        '#10+
  138. '                       pa=length(p);                                                  '#10+
  139. '               }                                                                      '#10+
  140. '               float dm=max(0.,darkmatter-a*a*.001); //dark matter                    '#10+
  141. '               a*=a*a; // add contrast                                                '#10+
  142. '               if (r>6) fade*=1.-dm; // dark matter, don t render near                '#10+
  143. '               //v+=vec3(dm,dm*.5,0.);                                                '#10+
  144. '               v+=fade;                                                               '#10+
  145. '               v+=vec3(s,s*s,s*s*s*s)*a*brightness*fade; // coloring based on distance'#10+
  146. '               fade*=distfading; // distance fading                                   '#10+
  147. '               s+=stepsize;                                                           '#10+
  148. '       }                                                                              '#10+
  149. '       v=mix(vec3(length(v)),v,saturation); //color adjust                            '#10+
  150. '       gl_FragColor = vec4(v*.01,1.);                                                 '#10+
  151.  
  152. '}',
  153. 'varying vec2 texCoord;', '130');
  154.  
  155.   FTime := UniformSingle['time'];      // float uniform
  156.   FFact := UniformSingle['fct'];
  157.  
  158.   FRez := UniformSingle['rez'];
  159.  
  160.   FImageIndex := UniformInteger['image'];
  161.   FCanvasSize := UniformPointF['canvasSize'];
  162.   FImage_idx:= 0;
  163.   FTimer := 0;
  164.   FFactV := 0;
  165.   FRezV  := 512.0;
  166.  
  167. end;
  168.  
  169. procedure TBGLCMapShader.StartUse;
  170.  
  171. begin
  172.    inherited StartUse;
  173.    FTime.Update;
  174.    FFact.Update;
  175.    FRez.Update;
  176.    FImageIndex.Update;
  177.    FCanvasSize.Update;
  178.   // set values to uniforms
  179.   FRez.Value := FRezV;
  180.   FTime.Value:=FTimer;
  181.   FFact.Value:= FFactV;
  182.  end;
  183.  
  184. function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;
  185. var previousBuf,buf: TBGLCustomFrameBuffer;
  186.   previousShader: TBGLCustomShader;
  187.  
  188. begin
  189.   //previousBuf := Canvas.ActiveFrameBuffer;
  190.   //buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
  191.   //Canvas.ActiveFrameBuffer := buf;
  192.   //Canvas.Fill(BGRAPixelTransparent);
  193.   //previousShader := Canvas.Lighting.ActiveShader;
  194.   //Canvas.Lighting.ActiveShader := self;
  195.   //ATexture.Draw(0, 0);
  196.   //
  197.   //Canvas.Lighting.ActiveShader := previousShader;
  198.   //Canvas.ActiveFrameBuffer := previousBuf;
  199.   //result := buf.MakeTextureAndFree;
  200.  
  201.   // canvas renderer
  202.   previousBuf := Canvas.ActiveFrameBuffer;
  203.   buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
  204.   Canvas.ActiveFrameBuffer := buf;
  205.   Canvas.Fill(BGRAPixelTransparent);
  206.   RenderOnCanvas;
  207.   Canvas.ActiveFrameBuffer := previousBuf;
  208.   result := buf.MakeTextureAndFree;
  209.  
  210. end;
  211.  
  212. procedure TBGLCMapShader.RenderOnCanvas;
  213. var
  214.   previousShader: TBGLCustomShader;
  215. begin
  216.   previousShader := Canvas.Lighting.ActiveShader;
  217.   Canvas.Lighting.ActiveShader := self;
  218.   CanvasSize := PointF(800,600);
  219.   Canvas.FillRect(0, 0, 800,600, CSSWhite);
  220.   Canvas.Lighting.ActiveShader := previousShader;
  221. end;
  222. end.

Sub Quantum Technology ! Gigatron 68000 Colmar France;

circular

  • Hero Member
  • *****
  • Posts: 4356
    • Personal webpage
Re: Demo Scene BGRA GL Shader
« Reply #27 on: July 19, 2024, 09:35:04 am »
No idea how it works but it looks smooth and realistic.  :)
Conscience is the debugger of the mind

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene BGRA GL Shader
« Reply #28 on: July 19, 2024, 04:57:12 pm »
Hi ,
A last one start conversion faster than light (13min);

This time a Shader from Op]"]>Blockeds;
Sfx : Skaven / Future Crew  (Unreal II)

Live Video on YT :  https://www.youtube.com/watch?v=rNZx-MIJFU4

Shader Unit exceed the limit so it's attached in zip file;

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, BGRACMapShader, BGRABitmapTypes,mmsystem;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGLVirtualScreen1: TBGLVirtualScreen;
  17.     FloatSpinEdit1: TFloatSpinEdit;
  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.   public
  30.    texture,gl_surface : IBGLTexture;
  31.    fnt : IBGLFont;
  32.    FWavStream : TMemoryStream;
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.   fx_num : integer;
  38.   g_timer : integer;
  39.  
  40. implementation
  41.  
  42. {$R *.lfm}
  43.  
  44. { TForm1 }
  45.  
  46. procedure TForm1.FormCreate(Sender: TObject);
  47. begin
  48.    fnt := BGLFont('Arial',22);
  49.    fx_num  :=0;
  50.    g_timer :=0;
  51.   // audio stream
  52.   FWavStream    := TMemoryStream.Create;
  53.   FWavStream.LoadFromFile('2nd-pm.wav');
  54.   PlaySound(FWavStream.Memory, 0, SND_NODEFAULT or SND_LOOP or SND_ASYNC or SND_MEMORY);
  55.  
  56. end;
  57.  
  58.  
  59. procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
  60.   BGLContext: TBGLContext);
  61.  
  62. begin
  63.     gl_surface := BGLTexture(ResourceFile('gl_surface.png'));
  64.     texture     := BGLTexture(ResourceFile('girl5.png'));
  65.     cmap_shader := TBGLCMapShader.Create(BGLContext.Canvas);
  66.  
  67. end;
  68.  
  69. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
  70.   BGLContext: TBGLContext);
  71.  
  72. begin
  73.     // le traitement du sampler2D comme texture
  74.      cmap_shader.Rezolution:= 512.0;
  75.      cmap_shader.Factor :=  fx_num;
  76.      //gl_surface := cmap_shader.Render(texture);   // container de l'image affichee par le shader
  77.      //BGLContext.Canvas.PutImage(0 ,0, gl_surface,BGRA(255,255,255,255)); // le shader surface qui contient l'image
  78.  
  79.      // shader without texture ; canvas renderer
  80.      cmap_shader.RenderOnCanvas;
  81.  
  82.      fnt.TextOut(0,560,'BGRA GL MULTIPLE FX FROM OP]"]>BlockedS SFX : SKAVEN/FUTURE CREW');
  83. end;
  84.  
  85. procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
  86.   BGLContext: TBGLContext);
  87. begin
  88.   // libere et vire tout !!
  89.  
  90.   texture    := nil;
  91.   gl_surface := nil;
  92.   fnt        := nil;
  93.   FreeAndNil(cmap_shader);
  94. end;
  95.  
  96.  
  97. procedure TForm1.FormDestroy(Sender: TObject);
  98. begin
  99.   PlaySound(nil, 0, 0);
  100.   FWavStream.Free;
  101. end;
  102.  
  103. procedure TForm1.Timer1Timer(Sender: TObject);
  104. begin
  105.     cmap_shader.Time   := cmap_shader.Time + FloatSpinEdit1.value/1000;
  106.     inc(g_timer);
  107.     if(g_timer>500) then
  108.     begin
  109.     fx_num := fx_num +1;
  110.  
  111.     g_timer := 0;
  112.     if(fx_num>=26) then fx_num :=0;
  113.     end;
  114.  
  115.     BGLVirtualScreen1.Invalidate;
  116. end;
  117.  
  118. end.
  119.  


« Last Edit: July 19, 2024, 05:02:56 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

circular

  • Hero Member
  • *****
  • Posts: 4356
    • Personal webpage
Re: Demo Scene BGRA GL Shader
« Reply #29 on: July 19, 2024, 05:46:38 pm »
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.
Conscience is the debugger of the mind

 

TinyPortal © 2005-2018