// SPDX-License-Identifier: LGPL-3.0-linking-exception
{ Hue X/Y Shift OpenGL shader }
unit BGRACMapShader;
{$mode objfpc}{$H+}
interface
uses
BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
type
{ Hue X/Y Shift Shader computing shader }
TBGLCMapShader = class(TBGLShader3D)
private
function GetCanvasSize: TPointF;
procedure SetCanvasSize(AValue: TPointF);
protected
FTime: TUniformVariableSingle;
FTimer : Single;
FFact: TUniformVariableSingle;
FFactV : Single;
FRez: TUniformVariableSingle;
FRezV : Single;
FImageIndex: TUniformVariableInteger;
FImage_idx : Integer;
FCanvasSize: TUniformVariablePointF;
procedure StartUse; override;
public
constructor Create(ACanvas: TBGLCustomCanvas);
function Render(ATexture: IBGLTexture): IBGLTexture; overload;
procedure RenderOnCanvas;
// propriete ecriture des uniforms
property Time: Single read FTimer write FTimer;
property Factor: Single read FFactV write FFactV;
property Rezolution: Single read FRezV write FRezV;
property ImageIndex: integer read FImage_idx write FImage_idx;
property CanvasSize: TPointF read GetCanvasSize write SetCanvasSize;
end;
implementation
function TBGLCMapShader.GetCanvasSize: TPointF;
begin
result := FCanvasSize.Value;
end;
procedure TBGLCMapShader.SetCanvasSize(AValue: TPointF);
begin
FCanvasSize.Value := AValue;
end;
{ TBGLCMapShader }
constructor TBGLCMapShader.Create(ACanvas: TBGLCustomCanvas);
begin
// vertex + fragment
inherited Create(ACanvas,
'uniform vec2 canvasSize;'#10 +
'void main(void) {'#10 +
' gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +
' gl_FrontColor = gl_Color;'#10 +
' texCoord = gl_Vertex.xy / canvasSize;'#10 +
' // texCoord = vec2(gl_MultiTexCoord0);'#10 +
'}',
// Star Nest by Pablo Roman Andrioli
// License: MIT
'#define iterations 16 '#10+
'#define formuparam 0.53 '#10+
'#define volsteps 20 '#10+
'#define stepsize 0.1 '#10+
'#define zoom 0.800 '#10+
'#define tile 0.850 '#10+
'#define speed 0.010 '#10+
'#define brightness 0.0015 '#10+
'#define darkmatter 0.300 '#10+
'#define distfading 0.730 '#10+
'#define saturation 0.850 '#10+
'out vec4 FragmentColor;'#10 +
'uniform float time;'#10+
'uniform float fct;'#10+
'uniform float rez;'#10+
'uniform sampler2D image;'#10+
'void main()'#10 +
'{'#10 +
'vec2 uv = texCoord.xy ; '#10+
// flip y
' uv.y = 1.-uv.y; '#10+
// resolution down
'uv = floor(rez*uv)/rez; '#10+
// move texture
'vec2 xy = vec2(0.0,0.40); '#10+
'//uv.y*=800./600.0; '#10+
' vec3 dir=vec3(uv*zoom,1.); '#10+
' float tm=time*speed+.25; '#10+
' float a1=.5; '#10+
' float a2=.8; '#10+
' mat2 rot1=mat2(cos(a1),sin(a1),-sin(a1),cos(a1)); '#10+
' mat2 rot2=mat2(cos(a2),sin(a2),-sin(a2),cos(a2)); '#10+
' dir.xz*=rot1; '#10+
' dir.xy*=rot2; '#10+
' vec3 from=vec3(1.,.5,0.5); '#10+
' from+=vec3(tm,0,-2.); '#10+
' from.xz*=rot1; '#10+
' from.xy*=rot2; '#10+
' '#10+
' //volumetric rendering '#10+
' float s=0.1,fade=1.; '#10+
' vec3 v=vec3(0.); '#10+
' for (int r=0; r<volsteps; r++) { '#10+
' vec3 p=from+s*dir*.5; '#10+
' p = abs(vec3(tile)-mod(p,vec3(tile*2.))); // tiling fold '#10+
' float pa,a=pa=0.; '#10+
' for (int i=0; i<iterations; i++) { '#10+
' p=abs(p)/dot(p,p)-formuparam; // the magic formula '#10+
' a+=abs(length(p)-pa); // absolute sum of average change '#10+
' pa=length(p); '#10+
' } '#10+
' float dm=max(0.,darkmatter-a*a*.001); //dark matter '#10+
' a*=a*a; // add contrast '#10+
' if (r>6) fade*=1.-dm; // dark matter, don t render near '#10+
' //v+=vec3(dm,dm*.5,0.); '#10+
' v+=fade; '#10+
' v+=vec3(s,s*s,s*s*s*s)*a*brightness*fade; // coloring based on distance'#10+
' fade*=distfading; // distance fading '#10+
' s+=stepsize; '#10+
' } '#10+
' v=mix(vec3(length(v)),v,saturation); //color adjust '#10+
' gl_FragColor = vec4(v*.01,1.); '#10+
'}',
'varying vec2 texCoord;', '130');
FTime := UniformSingle['time']; // float uniform
FFact := UniformSingle['fct'];
FRez := UniformSingle['rez'];
FImageIndex := UniformInteger['image'];
FCanvasSize := UniformPointF['canvasSize'];
FImage_idx:= 0;
FTimer := 0;
FFactV := 0;
FRezV := 512.0;
end;
procedure TBGLCMapShader.StartUse;
begin
inherited StartUse;
FTime.Update;
FFact.Update;
FRez.Update;
FImageIndex.Update;
FCanvasSize.Update;
// set values to uniforms
FRez.Value := FRezV;
FTime.Value:=FTimer;
FFact.Value:= FFactV;
end;
function TBGLCMapShader.Render(ATexture: IBGLTexture): IBGLTexture;
var previousBuf,buf: TBGLCustomFrameBuffer;
previousShader: TBGLCustomShader;
begin
//previousBuf := Canvas.ActiveFrameBuffer;
//buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
//Canvas.ActiveFrameBuffer := buf;
//Canvas.Fill(BGRAPixelTransparent);
//previousShader := Canvas.Lighting.ActiveShader;
//Canvas.Lighting.ActiveShader := self;
//ATexture.Draw(0, 0);
//
//Canvas.Lighting.ActiveShader := previousShader;
//Canvas.ActiveFrameBuffer := previousBuf;
//result := buf.MakeTextureAndFree;
// canvas renderer
previousBuf := Canvas.ActiveFrameBuffer;
buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
Canvas.ActiveFrameBuffer := buf;
Canvas.Fill(BGRAPixelTransparent);
RenderOnCanvas;
Canvas.ActiveFrameBuffer := previousBuf;
result := buf.MakeTextureAndFree;
end;
procedure TBGLCMapShader.RenderOnCanvas;
var
previousShader: TBGLCustomShader;
begin
previousShader := Canvas.Lighting.ActiveShader;
Canvas.Lighting.ActiveShader := self;
CanvasSize := PointF(800,600);
Canvas.FillRect(0, 0, 800,600, CSSWhite);
Canvas.Lighting.ActiveShader := previousShader;
end;
end.
Recent
