1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRABlurGL;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 BGRAClasses, BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
10
11 type
12
13 { TBGLBlurShader }
14
15 TBGLBlurShader = class(TBGLShader3D)
16 private
GetDirectionnull17 function GetDirection: TPointF;
GetImageIndexnull18 function GetImageIndex: integer;
GetRadiusnull19 function GetRadius: Single;
GetTextureSizenull20 function GetTextureSize: TPoint;
21 procedure SetDirection(AValue: TPointF);
22 procedure SetImageIndex(AValue: integer);
23 procedure SetRadius(AValue: Single);
24 procedure SetTextureSize(AValue: TPoint);
25 protected
26 FTextureSize: TUniformVariablePoint;
27 FImageIndex: TUniformVariableInteger;
28 FDirection: TUniformVariablePointF;
29 FRadius: TUniformVariableSingle;
30 FBlurType: TRadialBlurType;
31 procedure StartUse; override;
32 public
33 constructor Create(ACanvas: TBGLCustomCanvas; ABlurType: TRadialBlurType);
FilterBlurMotionnull34 function FilterBlurMotion(ATexture: IBGLTexture): IBGLTexture; overload;
FilterBlurMotionnull35 function FilterBlurMotion(ATexture: IBGLTexture; ADirection: TPointF): IBGLTexture; overload;
FilterBlurRadialnull36 function FilterBlurRadial(ATexture: IBGLTexture): IBGLTexture;
37 property ImageIndex: integer read GetImageIndex write SetImageIndex;
38 property TextureSize: TPoint read GetTextureSize write SetTextureSize;
39 property Direction: TPointF read GetDirection write SetDirection;
40 property Radius: Single read GetRadius write SetRadius;
41 property BlurType: TRadialBlurType read FBlurType;
42 end;
43
44 implementation
45
46 { TBGLBlurShader }
47
GetDirectionnull48 function TBGLBlurShader.GetDirection: TPointF;
49 begin
50 result := FDirection.Value;
51 end;
52
TBGLBlurShader.GetImageIndexnull53 function TBGLBlurShader.GetImageIndex: integer;
54 begin
55 result := FImageIndex.Value;
56 end;
57
TBGLBlurShader.GetRadiusnull58 function TBGLBlurShader.GetRadius: Single;
59 begin
60 result := FRadius.Value;
61 if FBlurType = rbPrecise then result := result * 10;
62 end;
63
TBGLBlurShader.GetTextureSizenull64 function TBGLBlurShader.GetTextureSize: TPoint;
65 begin
66 result := FTextureSize.Value;
67 end;
68
69 procedure TBGLBlurShader.SetDirection(AValue: TPointF);
70 begin
71 FDirection.Value := AValue;
72 end;
73
74 procedure TBGLBlurShader.SetImageIndex(AValue: integer);
75 begin
76 FImageIndex.Value := AValue;
77 end;
78
79 procedure TBGLBlurShader.SetRadius(AValue: Single);
80 begin
81 if FBlurType = rbPrecise then AValue := AValue/10;
82 FRadius.Value := AValue;
83 end;
84
85 procedure TBGLBlurShader.SetTextureSize(AValue: TPoint);
86 begin
87 FTextureSize.Value:= AValue;
88 end;
89
90 constructor TBGLBlurShader.Create(ACanvas: TBGLCustomCanvas; ABlurType: TRadialBlurType);
91 var weightFunc: string;
92 begin
93 FBlurType:= ABlurType;
94 case ABlurType of
95 rbNormal,rbPrecise: weightFunc:=
96 ' float sigma = max(0.1,radius/1.8);'#10+
97 ' float normalized = x/sigma;'#10 +
98 ' return 1/(2.506628274631*sigma)*exp(-0.5*normalized*normalized);';
99 rbCorona: weightFunc := 'return max(0, 1-abs(x-radius));';
100 rbFast: weightFunc := 'return max(0,radius+1-x);';
101 else {rbBox,rbDisk}
102 weightFunc := 'if (x <= radius) return 1; else return max(0,radius+1-x);';
103 end;
104
105 inherited Create(ACanvas,
106 'void main(void) {'#10 +
107 ' gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +
108 ' texCoord = vec2(gl_MultiTexCoord0);'#10 +
109 '}',
110
111 'uniform sampler2D image;'#10 +
112 'uniform ivec2 textureSize;'#10 +
113 'uniform vec2 direction;'#10 +
114 'uniform float radius;'#10 +
115 'out vec4 FragmentColor;'#10 +
116
117 'float computeWeight(float x)'#10 +
118 '{'#10 +
119 weightFunc + #10 +
120 '}'#10 +
121
122 'void main(void)'#10 +
123 '{'#10 +
124 ' int range = int(radius+1.5);'#10 +
125
126 ' float weight = computeWeight(0);'#10 +
127 ' float totalWeight = weight;'#10 +
128 ' FragmentColor = texture2D( image, texCoord ) * weight;'#10 +
129
130 ' for (int i=1; i<=range; i++) {'#10 +
131 ' weight = computeWeight(i);'#10 +
132 ' FragmentColor += texture2D( image, texCoord + i*direction/textureSize ) * weight;'#10 +
133 ' FragmentColor += texture2D( image, texCoord - i*direction/textureSize ) * weight;'#10 +
134 ' totalWeight += 2*weight;'#10 +
135 ' }'#10 +
136
137 ' FragmentColor /= totalWeight;'#10 +
138 '}',
139
140 'varying vec2 texCoord;', '130');
141
142 FImageIndex := UniformInteger['image'];
143 FTextureSize := UniformPoint['textureSize'];
144 FDirection := UniformPointF['direction'];
145 FRadius := UniformSingle['radius'];
146
147 ImageIndex:= 0;
148 Direction := PointF(1,0);
149 TextureSize := Point(1,1);
150 Radius := 0;
151 end;
152
TBGLBlurShader.FilterBlurRadialnull153 function TBGLBlurShader.FilterBlurRadial(ATexture: IBGLTexture): IBGLTexture;
154 var horiz: IBGLTexture;
155 begin
156 horiz := FilterBlurMotion(ATexture, PointF(1,0));
157 result := FilterBlurMotion(horiz, PointF(0,1));
158 end;
159
FilterBlurMotionnull160 function TBGLBlurShader.FilterBlurMotion(ATexture: IBGLTexture): IBGLTexture;
161 var previousBuf,buf: TBGLCustomFrameBuffer;
162 previousShader: TBGLCustomShader;
163 begin
164 previousBuf := Canvas.ActiveFrameBuffer;
165 buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
166 Canvas.ActiveFrameBuffer := buf;
167
168 TextureSize := Point(ATexture.Width,ATexture.Height);
169 previousShader := Canvas.Lighting.ActiveShader;
170 Canvas.Lighting.ActiveShader := self;
171
172 ATexture.Draw(0, 0); //perform horiz blur
173
174 Canvas.Lighting.ActiveShader := previousShader;
175 Canvas.ActiveFrameBuffer := previousBuf;
176 result := buf.MakeTextureAndFree;
177 end;
178
FilterBlurMotionnull179 function TBGLBlurShader.FilterBlurMotion(ATexture: IBGLTexture;
180 ADirection: TPointF): IBGLTexture;
181 var prevDir: TPointF;
182 begin
183 prevDir := Direction;
184 Direction := ADirection;
185 result := FilterBlurMotion(ATexture);
186 Direction := prevDir;
187 end;
188
189 procedure TBGLBlurShader.StartUse;
190 begin
191 inherited StartUse;
192 FImageIndex.Update;
193 FTextureSize.Update;
194 FDirection.Update;
195 FRadius.Update;
196 end;
197
198 end.
199
200
201