1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRAOpenGL;
3
4 {$mode objfpc}{$H+}
5 {$I bgrabitmap.inc}
6
7 interface
8
9 uses
10 BGRAClasses, SysUtils, FPimage, BGRAGraphics,
11 BGRAOpenGLType, BGRASpriteGL, BGRACanvasGL, GL, GLext, GLU, BGRABitmapTypes,
12 BGRAFontGL, BGRASSE, BGRAMatrix3D;
13
14 type
15 TBGLCustomCanvas = BGRACanvasGL.TBGLCustomCanvas;
16 TBGLSprite = TBGLDefaultSprite;
17 IBGLTexture = BGRAOpenGLType.IBGLTexture;
18 IBGLFont = BGRAOpenGLType.IBGLFont;
19 IBGLRenderedFont = BGRAFontGL.IBGLRenderedFont;
20 TOpenGLResampleFilter = BGRAOpenGLType.TOpenGLResampleFilter;
21 TOpenGLBlendMode = BGRAOpenGLType.TOpenGLBlendMode;
22 TBGLPath = BGRACanvasGL.TBGLPath;
23 TWaitForGPUOption = BGRAOpenGLType.TWaitForGPUOption;
24 TBGLCustomElementArray = BGRACanvasGL.TBGLCustomElementArray;
25 TBGLCustomArray = BGRACanvasGL.TBGLCustomArray;
26 TOpenGLPrimitive = BGRAOpenGLType.TOpenGLPrimitive;
27 TTextLayout = BGRAGraphics.TTextLayout;
28
29 const
30 tlTop = BGRAGraphics.tlTop;
31 tlCenter = BGRAGraphics.tlCenter;
32 tlBottom = BGRAGraphics.tlBottom;
33
34 type
35 { TBGLContext }
36
37 TBGLContext = object
38 private
GetHeightnull39 function GetHeight: integer;
GetWidthnull40 function GetWidth: integer;
41 public
42 Canvas: TBGLCustomCanvas;
43 Sprites: TBGLCustomSpriteEngine;
44 property Width: integer read GetWidth;
45 property Height: integer read GetHeight;
46 end;
47
48 { TBGLFrameBuffer }
49
50 TBGLFrameBuffer = class(TBGLCustomFrameBuffer)
51 protected
52 FHeight: integer;
53 FMatrix: TAffineMatrix;
54 FProjectionMatrix: TMatrix4D;
55 FTexture: IBGLTexture;
56 FFrameBufferId, FRenderBufferId: GLuint;
57 FWidth: integer;
58 FSettingMatrices: boolean;
GetTexturenull59 function GetTexture: IBGLTexture; override;
GetHandlenull60 function GetHandle: pointer; override;
GetHeightnull61 function GetHeight: integer; override;
GetMatrixnull62 function GetMatrix: TAffineMatrix; override;
GetProjectionMatrixnull63 function GetProjectionMatrix: TMatrix4D; override;
GetWidthnull64 function GetWidth: integer; override;
65 procedure SetMatrix(AValue: TAffineMatrix); override;
66 procedure SetProjectionMatrix(AValue: TMatrix4D); override;
67 public
68 constructor Create(AWidth,AHeight: integer);
MakeTextureAndFreenull69 function MakeTextureAndFree: IBGLTexture; override;
70 destructor Destroy; override;
71 end;
72
73 const
74 orfBox = BGRAOpenGLType.orfBox;
75 orfLinear = BGRAOpenGLType.orfLinear;
76 obmNormal = BGRAOpenGLType.obmNormal;
77 obmAdd = BGRAOpenGLType.obmAdd;
78 obmMultiply = BGRAOpenGLType.obmMultiply;
79 wfgQueueAllCommands = BGRAOpenGLType.wfgQueueAllCommands;
80 wfgFinishAllCommands = BGRAOpenGLType.wfgFinishAllCommands;
81 opPoints = BGRAOpenGLType.opPoints;
82 opLineStrip = BGRAOpenGLType.opLineStrip;
83 opLineLoop = BGRAOpenGLType.opLineLoop;
84 opLines = BGRAOpenGLType.opLines;
85 opTriangleStrip = BGRAOpenGLType.opTriangleStrip;
86 opTriangleFan = BGRAOpenGLType.opTriangleFan;
87 opTriangles = BGRAOpenGLType.opTriangles;
88
89 type
90 { TBGLBitmap }
91
92 TBGLBitmap = class(TBGLCustomBitmap)
93 protected
GetOpenGLMaxTexSizenull94 function GetOpenGLMaxTexSize: integer; override;
95 public
NewBitmapnull96 function NewBitmap: TBGLBitmap; overload; override;
NewBitmapnull97 function NewBitmap(AWidth, AHeight: integer): TBGLBitmap; overload; override;
NewBitmapnull98 function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGLBitmap; overload; override;
NewBitmapnull99 function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGLBitmap; overload; override;
NewBitmapnull100 function NewBitmap(Filename: string): TBGLBitmap; overload; override;
NewBitmapnull101 function NewBitmap(Filename: string; AIsUtf8: boolean): TBGLBitmap; overload; override;
NewBitmapnull102 function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGLBitmap; overload; override;
NewBitmapnull103 function NewBitmap(AFPImage: TFPCustomImage): TBGLBitmap; overload; override;
NewReferencenull104 function NewReference: TBGLBitmap; override;
GetUniquenull105 function GetUnique: TBGLBitmap; override;
Duplicatenull106 function Duplicate(DuplicateProperties: Boolean = False): TBGLBitmap; overload; override;
Duplicatenull107 function Duplicate(DuplicateProperties, DuplicateXorMask: Boolean) : TBGLBitmap; overload; override;
GetPartnull108 function GetPart(const ARect: TRect): TBGLBitmap; override;
CreateBrushTexturenull109 function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
110 AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGLBitmap; override;
Resamplenull111 function Resample(newWidth, newHeight: integer;
112 mode: TResampleMode = rmFineResample): TBGLBitmap; override;
FilterSmartZoom3null113 function FilterSmartZoom3(Option: TMedianOption): TBGLBitmap; override;
FilterMediannull114 function FilterMedian(Option: TMedianOption): TBGLBitmap; override;
FilterSmoothnull115 function FilterSmooth: TBGLBitmap; override;
FilterSharpennull116 function FilterSharpen(Amount: single = 1): TBGLBitmap; overload; override;
FilterSharpennull117 function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGLBitmap; overload; override;
FilterContournull118 function FilterContour(AGammaCorrection: boolean = false): TBGLBitmap; override;
FilterPixelatenull119 function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGLBitmap; override;
FilterBlurRadialnull120 function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGLBitmap; overload; override;
FilterBlurRadialnull121 function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGLBitmap; overload; override;
FilterBlurRadialnull122 function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGLBitmap; overload; override;
FilterBlurRadialnull123 function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGLBitmap; overload; override;
FilterBlurMotionnull124 function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGLBitmap; overload; override;
FilterBlurMotionnull125 function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGLBitmap; overload; override;
FilterCustomBlurnull126 function FilterCustomBlur(mask: TCustomUniversalBitmap): TBGLBitmap; overload; override;
FilterCustomBlurnull127 function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TBGLBitmap; overload; override;
FilterEmbossnull128 function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGLBitmap; overload; override;
FilterEmbossnull129 function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGLBitmap; overload; override;
FilterEmbossHighlightnull130 function FilterEmbossHighlight(FillSelection: boolean): TBGLBitmap; overload; override;
FilterEmbossHighlightnull131 function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGLBitmap; overload; override;
FilterEmbossHighlightnull132 function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGLBitmap; overload; override;
FilterGrayscalenull133 function FilterGrayscale: TBGLBitmap; overload; override;
FilterGrayscalenull134 function FilterGrayscale(ABounds: TRect): TBGLBitmap; overload; override;
FilterNormalizenull135 function FilterNormalize(eachChannel: boolean = True): TBGLBitmap; overload; override;
FilterNormalizenull136 function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGLBitmap; overload; override;
FilterRotatenull137 function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGLBitmap; override;
FilterAffinenull138 function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGLBitmap; override;
FilterSpherenull139 function FilterSphere: TBGLBitmap; override;
FilterTwirlnull140 function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGLBitmap; overload; override;
FilterTwirlnull141 function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGLBitmap; overload; override;
FilterCylindernull142 function FilterCylinder: TBGLBitmap; override;
FilterPlanenull143 function FilterPlane: TBGLBitmap; override;
144 end;
145
BGLTexturenull146 function BGLTexture(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer): IBGLTexture; overload;
BGLTexturenull147 function BGLTexture(AFPImage: TFPCustomImage): IBGLTexture; overload;
BGLTexturenull148 function BGLTexture(ABitmap: TBitmap): IBGLTexture; overload;
BGLTexturenull149 function BGLTexture(AWidth, AHeight: integer; Color: TColor): IBGLTexture; overload;
BGLTexturenull150 function BGLTexture(AWidth, AHeight: integer; Color: TBGRAPixel): IBGLTexture; overload;
BGLTexturenull151 function BGLTexture(AFilenameUTF8: string): IBGLTexture; overload;
BGLTexturenull152 function BGLTexture(AFilenameUTF8: string; AWidth, AHeight: integer; AResampleFilter: TResampleFilter = rfBox): IBGLTexture; overload;
BGLTexturenull153 function BGLTexture(AStream: TStream): IBGLTexture; overload;
154
BGLSpriteEnginenull155 function BGLSpriteEngine: TBGLCustomSpriteEngine;
156
BGLCanvasnull157 function BGLCanvas: TBGLCustomCanvas;
158
159 procedure BGLViewPort(AWidth,AHeight: integer); overload;
160 procedure BGLViewPort(AWidth,AHeight: integer; AColor: TBGRAPixel); overload;
161
BGLFontnull162 function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload;
BGLFontnull163 function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AColor: TBGRAPixel; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload;
BGLFontnull164 function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; {%H-}AColor: TBGRAPixel; {%H-}AOutlineColor: TBGRAPixel; {%H-}AStyle: TFontStyles = []): IBGLRenderedFont; overload;
BGLFontnull165 function BGLFont({%H-}AName: string; {%H-}AEmHeight: integer; ARenderer: TBGRACustomFontRenderer; ARendererOwned: boolean = true): IBGLRenderedFont; overload;
166
167 type
168 { TBGLElementArray }
169
170 TBGLElementArray = class(TBGLCustomElementArray)
171 protected
172 FElements: packed array of GLuint;
173 FBuffer: GLuint;
GetCountnull174 function GetCount: integer; override;
175 public
176 constructor Create(const AElements: array of integer); override;
177 procedure Draw(ACanvas: TBGLCustomCanvas; APrimitive: TOpenGLPrimitive; AAttributes: array of TAttributeVariable); override;
178 destructor Destroy; override;
179 end;
180
181 { TBGLArray }
182
183 TBGLArray = class(TBGLCustomArray)
184 protected
185 FBufferAddress: pointer;
186 FCount: integer;
187 FRecordSize: integer;
GetCountnull188 function GetCount: integer; override;
GetRecordSizenull189 function GetRecordSize: integer; override;
190 public
191 constructor Create(ABufferAddress: Pointer; ACount: integer; ARecordSize: integer); override;
192 destructor Destroy; override;
193 end;
194
195 implementation
196
197 uses BGRABlurGL, BGRATransform{$IFDEF BGRABITMAP_USE_LCL}, BGRAText, BGRATextFX{$ENDIF};
198
199 type
200 TBlendFuncSeparateProc = procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF Windows} stdcall; {$ELSE} cdecl; {$ENDIF}
201
PrimitiveToOpenGLnull202 function PrimitiveToOpenGL(AValue: TOpenGLPrimitive): GLenum;
203 begin
204 case AValue of
205 opPoints: result := GL_POINTS;
206 opLineStrip: result := GL_LINE_STRIP;
207 opLineLoop: result := GL_LINE_LOOP;
208 opLines: result := GL_LINES;
209 opTriangleStrip: result := GL_TRIANGLE_STRIP;
210 opTriangleFan: result := GL_TRIANGLE_FAN;
211 opTriangles: result := GL_TRIANGLES;
212 else
213 raise exception.Create('Unknown primitive type');
214 end;
215 end;
216
217 procedure NeedOpenGL2_0;
218 begin
219 if glUseProgram = nil then
220 begin
221 if not Load_GL_version_2_0 then
222 raise exception.Create('Cannot load OpenGL 2.0');
223 end;
224 end;
225
CheckOpenGL2_0null226 function CheckOpenGL2_0: boolean;
227 begin
228 if glUseProgram = nil then
229 begin
230 result := Load_GL_version_2_0;
231 end
232 else
233 result := true;
234 end;
235
236 var
237 BGLCanvasInstance: TBGLCustomCanvas;
238 glBlendFuncSeparate: TBlendFuncSeparateProc;
239 glBlendFuncSeparateFetched: boolean;
240
241 const
242 GL_COMBINE_ARB = $8570;
243 GL_COMBINE_RGB_ARB = $8571;
244 GL_SOURCE0_RGB_ARB = $8580;
245 GL_PRIMARY_COLOR_ARB = $8577;
246
247 type
248 { TBGLTexture }
249
250 TBGLTexture = class(TBGLCustomTexture)
251 protected
252 FFlipX,FFlipY: Boolean;
253
GetOpenGLMaxTexSizenull254 function GetOpenGLMaxTexSize: integer; override;
CreateOpenGLTexturenull255 function CreateOpenGLTexture(ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer; RGBAOrder: boolean): TBGLTextureHandle; override;
256 procedure UpdateOpenGLTexture(ATexture: TBGLTextureHandle; ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth,AActualHeight: integer; RGBAOrder: boolean); override;
SupportsBGRAOrdernull257 class function SupportsBGRAOrder: boolean; override;
258 procedure SetOpenGLTextureSize(ATexture: TBGLTextureHandle; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); override;
259 procedure ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; FramesX: Integer=1; FramesY: Integer=1); override;
GetOpenGLFrameCountnull260 function GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; override;
GetEmptyTexturenull261 function GetEmptyTexture: TBGLTextureHandle; override;
262 procedure FreeOpenGLTexture(ATexture: TBGLTextureHandle); override;
263 procedure UpdateGLResampleFilter(ATexture: TBGLTextureHandle; AFilter: TOpenGLResampleFilter); override;
264
265 procedure InternalSetColor(const AColor: TBGRAPixel);
266 procedure DoDrawTriangleOrQuad(const APoints: array of TPointF;
267 const APointsZ: array of Single; const APoints3D: array of TPoint3D_128;
268 const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF;
269 const AColors: array of TColorF); override;
270 procedure DoDraw(pt1,pt2,pt3,pt4: TPointF; AColor: TBGRAPixel);
271 procedure DoStretchDraw(x,y,w,h: single; AColor: TBGRAPixel); override;
272 procedure DoStretchDrawAngle(x,y,w,h,angleDeg: single; rotationCenter: TPointF; AColor: TBGRAPixel); override;
273 procedure DoDrawAffine(Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); override;
274 procedure Init(ATexture: TBGLTextureHandle; AWidth,AHeight: integer; AOwned: boolean); override;
275 procedure NotifyInvalidFrameSize; override;
276 procedure NotifyErrorLoadingFile(AFilenameUTF8: string); override;
277
NewEmptynull278 function NewEmpty: TBGLCustomTexture; override;
NewFromTexturenull279 function NewFromTexture(ATexture: TBGLTextureHandle; AWidth,AHeight: integer): TBGLCustomTexture; override;
Duplicatenull280 function Duplicate: TBGLCustomTexture; override;
281
282 public
283 procedure ToggleFlipX; override;
284 procedure ToggleFlipY; override;
285 procedure Bind(ATextureNumber: integer); override;
FilterBlurMotionnull286 function FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture; override;
FilterBlurRadialnull287 function FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture; override;
288
289 end;
290
291 POpenGLTexture = ^TOpenGLTexture;
292 TOpenGLTexture = record
293 ID: GLuint;
294 AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight: integer;
295 FramesCoord: array of array[0..3] of TPointF;
296 end;
297
298 { TBGLCanvas }
299
300 TBGLCanvas = class(TBGLCustomCanvas)
301 protected
302 FMatrix: TAffineMatrix;
303 FProjectionMatrix: TMatrix4D;
304 FBlendMode: TOpenGLBlendMode;
305 FLighting: TBGLCustomLighting;
306 FFaceCulling: TFaceCulling;
307
GetLightingnull308 function GetLighting: TBGLCustomLighting; override;
309
GetMatrixnull310 function GetMatrix: TAffineMatrix; override;
311 procedure SetMatrix(const AValue: TAffineMatrix); override;
GetProjectionMatrixnull312 function GetProjectionMatrix: TMatrix4D; override;
313 procedure SetProjectionMatrix(const AValue: TMatrix4D); override;
314
GetFaceCullingnull315 function GetFaceCulling: TFaceCulling; override;
316 procedure SetFaceCulling(AValue: TFaceCulling); override;
317
318 procedure InternalSetColor(const AColor: TBGRAPixel); override;
319 procedure InternalSetColorF(const AColor: TColorF); override;
320
321 procedure InternalStartPutPixel(const pt: TPointF); override;
322 procedure InternalStartPolyline(const pt: TPointF); override;
323 procedure InternalStartPolygon(const pt: TPointF); override;
324 procedure InternalStartTriangleFan(const pt: TPointF); override;
325 procedure InternalContinueShape(const pt: TPointF); overload; override;
326
327 procedure InternalContinueShape(const pt: TPoint3D); overload; override;
328 procedure InternalContinueShape(const pt: TPoint3D_128); overload; override;
329 procedure InternalContinueShape(const pt, normal: TPoint3D_128); overload; override;
330
331 procedure InternalEndShape; override;
332
333 procedure InternalStartBlend; override;
334 procedure InternalEndBlend; override;
335
336 procedure InternalStartBlendTriangles; override;
337 procedure InternalStartBlendQuads; override;
338 procedure InternalEndBlendTriangles; override;
339 procedure InternalEndBlendQuads; override;
340
341 procedure EnableScissor(AValue: TRect); override;
342 procedure DisableScissor; override;
343
GetBlendModenull344 function GetBlendMode: TOpenGLBlendMode; override;
345 procedure SetBlendMode(AValue: TOpenGLBlendMode); override;
346
347 procedure SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer); override;
348 public
349 destructor Destroy; override;
350 procedure Fill(AColor: TBGRAPixel); override;
351 procedure StartZBuffer; override;
352 procedure EndZBuffer; override;
353 procedure WaitForGPU(AOption: TWaitForGPUOption); override;
GetImagenull354 function GetImage(x, y, w, h: integer): TBGRACustomBitmap; override;
CreateFrameBuffernull355 function CreateFrameBuffer(AWidth, AHeight: integer): TBGLCustomFrameBuffer; override;
356 end;
357
358 { TBGLLighting }
359
360 TBGLLighting = class(TBGLCustomLighting)
361 protected
362 FLightUsage: array[0..7] of boolean;
363 FCurrentSpecularIndex: single;
364 FAmbiantLightF: TColorF;
365 FBuiltInLighting: boolean;
MakeShaderObjectnull366 function MakeShaderObject(AShaderType: GLenum; ASource: string): GLuint;
AddLightnull367 function AddLight(AColor: TColorF): integer;
GetSupportShadersnull368 function GetSupportShaders: boolean; override;
369 procedure SetAmbiantLightF(AAmbiantLight: TColorF); override;
GetAmbiantLightFnull370 function GetAmbiantLightF: TColorF; override;
GetBuiltInLightingEnablednull371 function GetBuiltInLightingEnabled: boolean; override;
372 procedure SetBuiltInLightingEnabled(AValue: boolean); override;
373 public
374 constructor Create;
AddDirectionalLightnull375 function AddDirectionalLight(AColor: TColorF; ADirection: TPoint3D): integer; override;
AddPointLightnull376 function AddPointLight(AColor: TColorF; APosition: TPoint3D; ALinearAttenuation, AQuadraticAttenuation: single): integer; override;
377 procedure ClearLights; override;
RemoveLightnull378 function RemoveLight(AIndex: integer): boolean; override;
379 procedure SetSpecularIndex(AIndex: integer); override;
380
MakeVertexShadernull381 function MakeVertexShader(ASource: string): LongWord; override;
MakeFragmentShadernull382 function MakeFragmentShader(ASource: string): LongWord; override;
MakeShaderProgramnull383 function MakeShaderProgram(AVertexShader, AFragmentShader: LongWord): LongWord; override;
384 procedure UseProgram(AProgram: LongWord); override;
385 procedure DeleteShaderObject(AShader: LongWord); override;
386 procedure DeleteShaderProgram(AProgram: LongWord); override;
GetUniformVariablenull387 function GetUniformVariable(AProgram: LongWord; AName: string): LongWord; override;
GetAttribVariablenull388 function GetAttribVariable(AProgram: LongWord; AName: string): LongWord; override;
389 procedure SetUniformSingle(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); override;
390 procedure SetUniformInteger(AVariable: LongWord; const AValue; AElementCount, AComponentCount: integer); override;
391 procedure BindAttribute(AAttribute: TAttributeVariable); override;
392 procedure UnbindAttribute(AAttribute: TAttributeVariable); override;
393 end;
394
395 { TBGLFrameBuffer }
396
397 procedure TBGLFrameBuffer.SetMatrix(AValue: TAffineMatrix);
398 begin
399 if FSettingMatrices then Exit;
400 FSettingMatrices := true;
401 FMatrix:=AValue;
402 if FCanvas <> nil then
403 TBGLCustomCanvas(FCanvas).Matrix := AValue;
404 FSettingMatrices := false;
405 end;
406
GetMatrixnull407 function TBGLFrameBuffer.GetMatrix: TAffineMatrix;
408 begin
409 result := FMatrix;
410 end;
411
TBGLFrameBuffer.GetTexturenull412 function TBGLFrameBuffer.GetTexture: IBGLTexture;
413 begin
414 result := FTexture.FlipY;
415 end;
416
GetHandlenull417 function TBGLFrameBuffer.GetHandle: pointer;
418 begin
419 result := @FFrameBufferId;
420 end;
421
TBGLFrameBuffer.GetHeightnull422 function TBGLFrameBuffer.GetHeight: integer;
423 begin
424 result := FHeight;
425 end;
426
GetProjectionMatrixnull427 function TBGLFrameBuffer.GetProjectionMatrix: TMatrix4D;
428 begin
429 result := FProjectionMatrix;
430 end;
431
GetWidthnull432 function TBGLFrameBuffer.GetWidth: integer;
433 begin
434 result := FWidth;
435 end;
436
437 procedure TBGLFrameBuffer.SetProjectionMatrix(AValue: TMatrix4D);
438 begin
439 if FSettingMatrices then Exit;
440 FSettingMatrices := true;
441 FProjectionMatrix:= AValue;
442 if FCanvas <> nil then
443 TBGLCustomCanvas(FCanvas).ProjectionMatrix := AValue;
444 FSettingMatrices := false;
445 end;
446
447 constructor TBGLFrameBuffer.Create(AWidth, AHeight: integer);
448 var frameBufferStatus: GLenum;
449 begin
450 if not Load_GL_version_3_0 then
451 raise exception.Create('Cannot load OpenGL 3.0');
452
453 FWidth := AWidth;
454 FHeight := AHeight;
455
456 FTexture := BGLTextureFactory.Create(nil,AWidth,AHeight,AWidth,AHeight);
457
458 //depth and stencil
459 glGenRenderbuffers(1, @FRenderBufferId);
460 glBindRenderbuffer(GL_RENDERBUFFER, FRenderBufferId);
461 glRenderbufferStorage(GL_RENDERBUFFER, GL_DEPTH24_STENCIL8, AWidth,AHeight);
462 glBindRenderbuffer(GL_RENDERBUFFER, 0);
463
464 glGenFramebuffers(1, @FFrameBufferId);
465 glBindFramebuffer(GL_FRAMEBUFFER, FFrameBufferId);
466
467 glFramebufferTexture2D(GL_FRAMEBUFFER, GL_COLOR_ATTACHMENT0, GL_TEXTURE_2D, PGLuint(FTexture.Handle)^, 0);
468 glFramebufferRenderbuffer(GL_FRAMEBUFFER, GL_DEPTH_STENCIL_ATTACHMENT, GL_RENDERBUFFER, FFrameBufferId);
469
470 frameBufferStatus:= glCheckFramebufferStatus(GL_FRAMEBUFFER);
471 glBindFramebuffer(GL_FRAMEBUFFER, 0);
472
473 if frameBufferStatus <> GL_FRAMEBUFFER_COMPLETE then
474 begin
475 glDeleteFramebuffers(1, @FFrameBufferId);
476 glDeleteRenderbuffers(1, @FRenderBufferId);
477 FTexture := nil;
478 raise exception.Create('Error ' + inttostr(frameBufferStatus) + ' while initializing frame buffer');
479 end;
480
481 UseOrthoProjection;
482 Matrix := AffineMatrixIdentity;
483 end;
484
TBGLFrameBuffer.MakeTextureAndFreenull485 function TBGLFrameBuffer.MakeTextureAndFree: IBGLTexture;
486 begin
487 result := FTexture;
488 FTexture := nil;
489 Free;
490 end;
491
492 destructor TBGLFrameBuffer.Destroy;
493 begin
494 glDeleteFramebuffers(1, @FFrameBufferId);
495 glDeleteRenderbuffers(1, @FRenderBufferId);
496 FTexture := nil;
497
498 inherited Destroy;
499 end;
500
501 procedure ApplyBlendMode(ABlendMode: TOpenGLBlendMode);
502 var
503 srcBlend : LongWord;
504 dstBlend : LongWord;
505 begin
506 case ABlendMode of
507 obmAdd:
508 begin
509 srcBlend := GL_SRC_ALPHA;
510 dstBlend := GL_ONE;
511 end;
512 obmMultiply:
513 begin
514 srcBlend := GL_ZERO;
515 dstBlend := GL_SRC_COLOR;
516 end
517 else
518 begin
519 srcBlend := GL_SRC_ALPHA;
520 dstBlend := GL_ONE_MINUS_SRC_ALPHA;
521 end;
522 end;
523 if not glBlendFuncSeparateFetched then
524 begin
525 glBlendFuncSeparate := TBlendFuncSeparateProc(wglGetProcAddress('glBlendFuncSeparate'));
526 glBlendFuncSeparateFetched := true;
527 end;
528 if Assigned(glBlendFuncSeparate) then
529 glBlendFuncSeparate( srcBlend, dstBlend, GL_ONE, GL_ONE_MINUS_SRC_ALPHA )
530 else
531 glBlendFunc( srcBlend, dstBlend );
532 end;
533
BGLTexturenull534 function BGLTexture(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight,
535 ActualWidth, ActualHeight: integer): IBGLTexture;
536 begin
537 result := TBGLTexture.Create(ARGBAData,AllocatedWidth, AllocatedHeight,
538 ActualWidth, ActualHeight);
539 end;
540
BGLTexturenull541 function BGLTexture(AFPImage: TFPCustomImage): IBGLTexture;
542 begin
543 result := TBGLTexture.Create(AFPImage);
544 end;
545
BGLTexturenull546 function BGLTexture(ABitmap: TBitmap): IBGLTexture;
547 begin
548 result := TBGLTexture.Create(ABitmap);
549 end;
550
BGLTexturenull551 function BGLTexture(AWidth, AHeight: integer; Color: TColor): IBGLTexture;
552 begin
553 result := TBGLTexture.Create(AWidth,AHeight,Color);
554 end;
555
BGLTexturenull556 function BGLTexture(AWidth, AHeight: integer; Color: TBGRAPixel): IBGLTexture;
557 begin
558 result := TBGLTexture.Create(AWidth,AHeight,Color);
559 end;
560
BGLTexturenull561 function BGLTexture(AFilenameUTF8: string): IBGLTexture;
562 begin
563 result := TBGLTexture.Create(AFilenameUTF8);
564 end;
565
BGLTexturenull566 function BGLTexture(AFilenameUTF8: string; AWidth, AHeight: integer; AResampleFilter: TResampleFilter): IBGLTexture;
567 begin
568 result := TBGLTexture.Create(AFilenameUTF8, AWidth, AHeight, AResampleFilter);
569 end;
570
BGLTexturenull571 function BGLTexture(AStream: TStream): IBGLTexture;
572 begin
573 result := TBGLTexture.Create(AStream);
574 end;
575
BGLSpriteEnginenull576 function BGLSpriteEngine: TBGLCustomSpriteEngine;
577 begin
578 result := BGRASpriteGL.BGLSpriteEngine;
579 end;
580
581 procedure BGLViewPort(AWidth, AHeight: integer; AColor: TBGRAPixel);
582 begin
583 BGLViewPort(AWidth,AHeight);
584 BGLCanvas.Fill(AColor);
585 end;
586
BGLFontnull587 function BGLFont(AName: string; AEmHeight: integer; AStyle: TFontStyles = []): IBGLRenderedFont;
588 begin
589 {$IFDEF BGRABITMAP_USE_LCL}
590 result := BGLFont(AName, AEmHeight, TLCLFontRenderer.Create);
591 result.Style := AStyle;
592 {$ELSE}
593 result := nil;
594 raise exception.Create('LCL renderer not available');
595 {$ENDIF}
596 end;
597
BGLFontnull598 function BGLFont(AName: string; AEmHeight: integer; AColor: TBGRAPixel;
599 AStyle: TFontStyles): IBGLRenderedFont;
600 begin
601 {$IFDEF BGRABITMAP_USE_LCL}
602 result := BGLFont(AName, AEmHeight, TLCLFontRenderer.Create);
603 result.Color := AColor;
604 result.Style := AStyle;
605 {$ELSE}
606 result := nil;
607 raise exception.Create('LCL renderer not available');
608 {$ENDIF}
609 end;
610
BGLFontnull611 function BGLFont(AName: string; AEmHeight: integer; AColor: TBGRAPixel;
612 AOutlineColor: TBGRAPixel; AStyle: TFontStyles = []): IBGLRenderedFont;
613 {$IFDEF BGRABITMAP_USE_LCL}
614 var renderer: TBGRATextEffectFontRenderer;
615 begin
616 renderer := TBGRATextEffectFontRenderer.Create;
617 renderer.OuterOutlineOnly:= true;
618 renderer.OutlineColor := AOutlineColor;
619 renderer.OutlineVisible := true;
620 result := BGLFont(AName, AEmHeight, renderer, true);
621 result.Color := AColor;
622 result.Style := AStyle;
623 end;
624 {$ELSE}
625 begin
626 result := nil;
627 raise exception.Create('LCL renderer not available');
628 end;
629 {$ENDIF}
630
BGLFontnull631 function BGLFont(AName: string; AEmHeight: integer;
632 ARenderer: TBGRACustomFontRenderer;
633 ARendererOwned: boolean): IBGLRenderedFont;
634 var f: TBGLRenderedFont;
635 begin
636 f:= TBGLRenderedFont.Create(ARenderer, ARendererOwned);
637 f.Name := AName;
638 f.EmHeight := AEmHeight;
639 result := f;
640 end;
641
BGLCanvasnull642 function BGLCanvas: TBGLCustomCanvas;
643 begin
644 result := BGLCanvasInstance;
645 end;
646
647 procedure BGLViewPort(AWidth, AHeight: integer);
648 begin
649 BGLCanvas.Width := AWidth;
650 BGLCanvas.Height := AHeight;
651 BGLCanvas.UseOrthoProjection;
652 BGLCanvas.Matrix := AffineMatrixIdentity;
653 BGLCanvas.FaceCulling := fcNone;
654 end;
655
656 { TBGLArray }
657
GetCountnull658 function TBGLArray.GetCount: integer;
659 begin
660 result := FCount;
661 end;
662
GetRecordSizenull663 function TBGLArray.GetRecordSize: integer;
664 begin
665 result := FRecordSize;
666 end;
667
668 constructor TBGLArray.Create(ABufferAddress: pointer; ACount: integer;
669 ARecordSize: integer);
670 var b: GLuint;
671 begin
672 NeedOpenGL2_0;
673 FBufferAddress:= ABufferAddress;
674 FCount := ACount;
675 FRecordSize:= ARecordSize;
676 glGenBuffers(1, @b);
677 FBuffer := b;
678 glBindBuffer(GL_ARRAY_BUFFER, FBuffer);
679 glBufferData(GL_ARRAY_BUFFER, FCount*FRecordSize, FBufferAddress, GL_STATIC_DRAW);
680 end;
681
682 destructor TBGLArray.Destroy;
683 var b: GLuint;
684 begin
685 b := FBuffer;
686 glDeleteBuffers(1, @b);
687 inherited Destroy;
688 end;
689
690 { TBGLElementArray }
691
TBGLElementArray.GetCountnull692 function TBGLElementArray.GetCount: integer;
693 begin
694 result := length(FElements);
695 end;
696
697 constructor TBGLElementArray.Create(const AElements: array of integer);
698 var bufferSize: integer;
699 i: Int32or64;
700 begin
701 NeedOpenGL2_0;
702 setlength(FElements,length(AElements));
703 bufferSize := length(FElements)*sizeof(integer);
704 for i := 0 to high(FElements) do
705 FElements[i] := AElements[i];
706 glGenBuffers(1, @FBuffer);
707 glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, FBuffer);
708 glBufferData(GL_ELEMENT_ARRAY_BUFFER, bufferSize, @FElements[0], GL_STATIC_DRAW);
709 end;
710
711 procedure TBGLElementArray.Draw(ACanvas: TBGLCustomCanvas; APrimitive: TOpenGLPrimitive; AAttributes: array of TAttributeVariable);
712 var
713 i: Int32or64;
714 begin
715 for i := 0 to high(AAttributes) do
716 ACanvas.Lighting.BindAttribute(AAttributes[i]);
717
718 glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, FBuffer);
719 glDrawElements(PrimitiveToOpenGL(APrimitive), Count, GL_UNSIGNED_INT, nil);
720
721 for i := 0 to high(AAttributes) do
722 ACanvas.Lighting.UnbindAttribute(AAttributes[i]);
723 end;
724
725 destructor TBGLElementArray.Destroy;
726 begin
727 glDeleteBuffers(1, @FBuffer);
728 inherited Destroy;
729 end;
730
731 { TBGLLighting }
732
733 procedure TBGLLighting.SetAmbiantLightF(AAmbiantLight: TColorF);
734 begin
735 FAmbiantLightF := AAmbiantLight;
736 glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @AAmbiantLight);
737 end;
738
739 constructor TBGLLighting.Create;
740 begin
741 FAmbiantLightF := ColorF(1,1,1,1);
742 end;
743
TBGLLighting.AddPointLightnull744 function TBGLLighting.AddPointLight(AColor: TColorF; APosition: TPoint3D; ALinearAttenuation, AQuadraticAttenuation: single): integer;
745 var
746 v: TPoint3D_128;
747 begin
748 result := AddLight(AColor);
749 if result <> -1 then
750 begin
751 v := Point3D_128(APosition);
752 v.t := 1;
753 glLightfv(GL_LIGHT0 + result, GL_POSITION, @v);
754 glLightf(GL_LIGHT0 + result, GL_CONSTANT_ATTENUATION, 0);
755 glLightf(GL_LIGHT0 + result, GL_LINEAR_ATTENUATION, ALinearAttenuation);
756 glLightf(GL_LIGHT0 + result, GL_QUADRATIC_ATTENUATION, AQuadraticAttenuation);
757 end;
758 end;
759
760 procedure TBGLLighting.ClearLights;
761 var
762 i: Integer;
763 begin
764 for i := 0 to High(FLightUsage) do
765 if FLightUsage[i] then
766 RemoveLight(i);
767 end;
768
TBGLLighting.AddDirectionalLightnull769 function TBGLLighting.AddDirectionalLight(AColor: TColorF; ADirection: TPoint3D): integer;
770 var
771 v: TPoint3D_128;
772 begin
773 result := AddLight(AColor);
774 if result <> -1 then
775 begin
776 v := Point3D_128(ADirection);
777 Normalize3D_128(v);
778 v.t := 0;
779 glLightfv(GL_LIGHT0 + result, GL_POSITION, @v);
780 end;
781 end;
782
783 procedure TBGLLighting.SetSpecularIndex(AIndex: integer);
784 var c: TColorF;
785 newIndex: single;
786 begin
787 newIndex := AIndex*0.5;
788 if newIndex < 0 then newIndex := 0;
789 if newIndex > 128 then newIndex := 128;
790 if newIndex <> FCurrentSpecularIndex then
791 begin
792 if newIndex = 0 then
793 c := ColorF(0,0,0,1)
794 else
795 c := ColorF(1,1,1,1);
796 glMaterialf(GL_FRONT_AND_BACK, GL_SHININESS, newIndex);
797 glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @c);
798 FCurrentSpecularIndex := newIndex;
799 end;
800 end;
801
MakeVertexShadernull802 function TBGLLighting.MakeVertexShader(ASource: string): LongWord;
803 begin
804 result := MakeShaderObject(GL_VERTEX_SHADER, ASource);
805 end;
806
TBGLLighting.MakeFragmentShadernull807 function TBGLLighting.MakeFragmentShader(ASource: string): LongWord;
808 begin
809 result := MakeShaderObject(GL_FRAGMENT_SHADER, ASource);
810 end;
811
TBGLLighting.GetAmbiantLightFnull812 function TBGLLighting.GetAmbiantLightF: TColorF;
813 begin
814 result := FAmbiantLightF;
815 end;
816
GetBuiltInLightingEnablednull817 function TBGLLighting.GetBuiltInLightingEnabled: boolean;
818 begin
819 result := FBuiltInLighting;
820 end;
821
822 procedure TBGLLighting.SetBuiltInLightingEnabled(AValue: boolean);
823 begin
824 if AValue = FBuiltInLighting then exit;
825 FBuiltInLighting:= AValue;
826 if AValue then
827 begin
828 glEnable(GL_LIGHTING);
829 glShadeModel(GL_SMOOTH);
830 glEnable(GL_COLOR_MATERIAL);
831 glColorMaterial(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE);
832 glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @FAmbiantLightF);
833 glLightModelf(GL_LIGHT_MODEL_LOCAL_VIEWER, 0);
834 glLightModelf(GL_LIGHT_MODEL_TWO_SIDE,1);
835 end else
836 begin
837 glDisable(GL_LIGHTING);
838 end;
839 end;
840
TBGLLighting.MakeShaderObjectnull841 function TBGLLighting.MakeShaderObject(AShaderType: GLenum; ASource: string
842 ): GLuint;
843 var
844 psource: pchar;
845 sourceLen: GLint;
846 shaderId: GLuint;
847 shaderOk: GLint;
848 log: string;
849 logLen: GLint;
850 begin
851 NeedOpenGL2_0;
852
853 if ASource = '' then
854 raise exception.Create('Empty code file provided');
855
856 shaderId := glCreateShader(AShaderType);
857 psource := @ASource[1];
858 sourceLen := length(ASource);
859 glShaderSource(shaderId, 1, @psource, @sourceLen);
860 glCompileShader(shaderId);
861
862 glGetShaderiv(shaderId, GL_COMPILE_STATUS, @shaderOk);
863 if not (shaderOk <> 0) then
864 begin
865 //retrieve error log
866 glGetShaderiv(shaderId, GL_INFO_LOG_LENGTH, @logLen);
867 setlength(log, logLen);
868 if logLen > 0 then
869 glGetShaderInfoLog(shaderId, logLen, nil, @log[1]);
870
871 glDeleteShader(shaderId);
872 raise exception.Create('Failed to compile shader: ' + log);
873 end;
874 result := shaderId;
875 end;
876
TBGLLighting.AddLightnull877 function TBGLLighting.AddLight(AColor: TColorF): integer;
878 var
879 i: Integer;
880 black: TColorF;
881 begin
882 for i := 0 to high(FLightUsage) do
883 if not FLightUsage[i] then
884 begin
885 result := i;
886 FLightUsage[i] := true;
887 black := ColorF(0,0,0,1);
888 glLightfv(GL_LIGHT0 + i, GL_AMBIENT, @black);
889 glLightfv(GL_LIGHT0 + i, GL_DIFFUSE, @AColor);
890 glLightfv(GL_LIGHT0 + i, GL_SPECULAR, @AColor);
891 glEnable(GL_LIGHT0 + i);
892 exit;
893 end;
894 result := -1;
895 end;
896
GetSupportShadersnull897 function TBGLLighting.GetSupportShaders: boolean;
898 begin
899 result := CheckOpenGL2_0;
900 end;
901
TBGLLighting.MakeShaderProgramnull902 function TBGLLighting.MakeShaderProgram(AVertexShader, AFragmentShader: LongWord): LongWord;
903 var
904 programOk: GLint;
905 shaderProgram: GLuint;
906 log: string;
907 logLen: GLint;
908 begin
909 NeedOpenGL2_0;
910
911 shaderProgram := glCreateProgram();
912 glAttachShader(shaderProgram, AVertexShader);
913 glAttachShader(shaderProgram, AFragmentShader);
914 glLinkProgram(shaderProgram);
915
916 glGetProgramiv(shaderProgram, GL_LINK_STATUS, @programOk);
917 if not (programOk <> 0) then
918 begin
919 //retrieve error log
920 glGetProgramiv(shaderProgram, GL_INFO_LOG_LENGTH, @logLen);
921 setlength(log, logLen);
922 if logLen > 0 then
923 glGetProgramInfoLog(shaderProgram, logLen, nil, @log[1]);
924
925 glDeleteProgram(shaderProgram);
926 raise exception.Create('Failed to link shader program: ' + log);
927 end;
928 result := shaderProgram;
929 end;
930
931 procedure TBGLLighting.UseProgram(AProgram: LongWord);
932 begin
933 NeedOpenGL2_0;
934 glUseProgram(AProgram);
935 end;
936
937 procedure TBGLLighting.DeleteShaderObject(AShader: LongWord);
938 begin
939 NeedOpenGL2_0;
940 if AShader<> 0 then
941 glDeleteShader(AShader);
942 end;
943
944 procedure TBGLLighting.DeleteShaderProgram(AProgram: LongWord);
945 begin
946 NeedOpenGL2_0;
947 if AProgram<> 0 then
948 glDeleteProgram(AProgram);
949 end;
950
TBGLLighting.GetUniformVariablenull951 function TBGLLighting.GetUniformVariable(AProgram: LongWord; AName: string): LongWord;
952 begin
953 NeedOpenGL2_0;
954 result := glGetUniformLocation(AProgram, @AName[1]);
955 end;
956
GetAttribVariablenull957 function TBGLLighting.GetAttribVariable(AProgram: LongWord; AName: string): LongWord;
958 begin
959 NeedOpenGL2_0;
960 result := glGetAttribLocation(AProgram, @AName[1]);
961 end;
962
963 procedure TBGLLighting.SetUniformSingle(AVariable: LongWord;
964 const AValue; AElementCount, AComponentCount: integer);
965 begin
966 NeedOpenGL2_0;
967 case AComponentCount of
968 1: glUniform1fv(AVariable, AElementCount, @AValue);
969 2: glUniform2fv(AVariable, AElementCount, @AValue);
970 3: glUniform3fv(AVariable, AElementCount, @AValue);
971 4: glUniform4fv(AVariable, AElementCount, @AValue);
972 9: glUniformMatrix3fv(AVariable, AElementCount, GL_FALSE, @AValue);
973 16: glUniformMatrix4fv(AVariable, AElementCount, GL_FALSE, @AValue);
974 else
975 raise exception.Create('Unexpected number of components');
976 end;
977 end;
978
979 procedure TBGLLighting.SetUniformInteger(AVariable: LongWord;
980 const AValue; AElementCount, AComponentCount: integer);
981 begin
982 NeedOpenGL2_0;
983 case AComponentCount of
984 1: glUniform1iv(AVariable, AElementCount, @AValue);
985 2: glUniform2iv(AVariable, AElementCount, @AValue);
986 3: glUniform3iv(AVariable, AElementCount, @AValue);
987 4: glUniform4iv(AVariable, AElementCount, @AValue);
988 else
989 raise exception.Create('Unexpected number of components');
990 end;
991 end;
992
993 procedure TBGLLighting.BindAttribute(AAttribute: TAttributeVariable);
994 var t: GLenum;
995 begin
996 glBindBuffer(GL_ARRAY_BUFFER, AAttribute.Source.Handle);
997 if AAttribute.IsFloat then
998 t := GL_FLOAT
999 else
1000 t := GL_INT;
1001 glVertexAttribPointer(AAttribute.Handle, AAttribute.VectorSize,t,GL_FALSE,
1002 AAttribute.Source.RecordSize, {%H-}pointer(PtrInt(AAttribute.RecordOffset)));
1003 glEnableVertexAttribArray(AAttribute.Handle);
1004 end;
1005
1006 procedure TBGLLighting.UnbindAttribute(AAttribute: TAttributeVariable);
1007 begin
1008 glDisableVertexAttribArray(AAttribute.Handle);
1009 end;
1010
RemoveLightnull1011 function TBGLLighting.RemoveLight(AIndex: integer): boolean;
1012 begin
1013 if (AIndex >= 0) and (AIndex <= high(FLightUsage)) and
1014 FLightUsage[AIndex] then
1015 begin
1016 glDisable(GL_LIGHT0 + AIndex);
1017 FLightUsage[AIndex] := false;
1018 result := true;
1019 end
1020 else
1021 result := false;
1022 end;
1023
1024 { TBGLContext }
1025
TBGLContext.GetHeightnull1026 function TBGLContext.GetHeight: integer;
1027 begin
1028 if Assigned(Canvas) then
1029 result := Canvas.Height
1030 else
1031 result := 0;
1032 end;
1033
GetWidthnull1034 function TBGLContext.GetWidth: integer;
1035 begin
1036 if Assigned(Canvas) then
1037 result := Canvas.Width
1038 else
1039 result := 0;
1040 end;
1041
1042 { TBGLCanvas }
1043
GetLightingnull1044 function TBGLCanvas.GetLighting: TBGLCustomLighting;
1045 begin
1046 if FLighting = nil then
1047 FLighting := TBGLLighting.Create;
1048 result := FLighting;
1049 end;
1050
GetMatrixnull1051 function TBGLCanvas.GetMatrix: TAffineMatrix;
1052 begin
1053 if ActiveFrameBuffer <> nil then
1054 result := ActiveFrameBuffer.Matrix
1055 else
1056 result := FMatrix;
1057 end;
1058
1059 procedure TBGLCanvas.SetMatrix(const AValue: TAffineMatrix);
1060 var m: TMatrix4D;
1061 begin
1062 glMatrixMode(GL_MODELVIEW);
1063 m := AffineMatrixToMatrix4D(AValue);
1064 glLoadMatrixf(@m);
1065
1066 if ActiveFrameBuffer <> nil then
1067 ActiveFrameBuffer.Matrix := AValue
1068 else
1069 FMatrix := AValue;
1070 end;
1071
TBGLCanvas.GetProjectionMatrixnull1072 function TBGLCanvas.GetProjectionMatrix: TMatrix4D;
1073 begin
1074 if ActiveFrameBuffer <> nil then
1075 result := ActiveFrameBuffer.ProjectionMatrix
1076 else
1077 result := FProjectionMatrix;
1078 end;
1079
1080 procedure TBGLCanvas.SetProjectionMatrix(const AValue: TMatrix4D);
1081 begin
1082 glMatrixMode(GL_PROJECTION);
1083 glLoadMatrixf(@AValue);
1084 glMatrixMode(GL_MODELVIEW);
1085
1086 if ActiveFrameBuffer <> nil then
1087 ActiveFrameBuffer.ProjectionMatrix := AValue
1088 else
1089 FProjectionMatrix := AValue;
1090 end;
1091
GetFaceCullingnull1092 function TBGLCanvas.GetFaceCulling: TFaceCulling;
1093 begin
1094 result := FFaceCulling;
1095 end;
1096
1097 procedure TBGLCanvas.SetFaceCulling(AValue: TFaceCulling);
1098 begin
1099 if AValue = FFaceCulling then exit;
1100 if FFaceCulling = fcNone then
1101 glEnable(GL_CULL_FACE);
1102 case AValue of
1103 fcNone: glDisable(GL_CULL_FACE);
1104 fcKeepCW: glFrontFace(GL_CW);
1105 fcKeepCCW: glFrontFace(GL_CCW);
1106 end;
1107 FFaceCulling:= AValue;
1108 end;
1109
1110 procedure TBGLCanvas.InternalStartPutPixel(const pt: TPointF);
1111 begin
1112 glBegin(GL_POINTS);
1113 glVertex2fv(@pt);
1114 end;
1115
1116 procedure TBGLCanvas.InternalStartPolyline(const pt: TPointF);
1117 begin
1118 glBegin(GL_LINE_STRIP);
1119 glVertex2fv(@pt);
1120 end;
1121
1122 procedure TBGLCanvas.InternalStartPolygon(const pt: TPointF);
1123 begin
1124 glBegin(GL_LINE_LOOP);
1125 glVertex2fv(@pt);
1126 end;
1127
1128 procedure TBGLCanvas.InternalStartTriangleFan(const pt: TPointF);
1129 begin
1130 glBegin(GL_TRIANGLE_FAN);
1131 glVertex2fv(@pt);
1132 end;
1133
1134 procedure TBGLCanvas.InternalContinueShape(const pt: TPointF);
1135 begin
1136 glVertex2fv(@pt);
1137 end;
1138
1139 procedure TBGLCanvas.InternalContinueShape(const pt: TPoint3D);
1140 begin
1141 glVertex3fv(@pt);
1142 end;
1143
1144 procedure TBGLCanvas.InternalContinueShape(const pt: TPoint3D_128);
1145 begin
1146 glVertex3fv(@pt);
1147 end;
1148
1149 procedure TBGLCanvas.InternalContinueShape(const pt, normal: TPoint3D_128);
1150 begin
1151 glNormal3fv(@normal);
1152 glVertex3fv(@pt);
1153 end;
1154
1155 procedure TBGLCanvas.InternalEndShape;
1156 begin
1157 glEnd();
1158 end;
1159
1160 procedure TBGLCanvas.InternalSetColor(const AColor: TBGRAPixel);
1161 begin
1162 {$PUSH}{$WARNINGS OFF}
1163 if TBGRAPixel_RGBAOrder then
1164 glColor4ubv(@AColor)
1165 else
1166 glColor4ub(AColor.red,AColor.green,AColor.blue,AColor.alpha);
1167 {$POP}
1168 end;
1169
1170 procedure TBGLCanvas.InternalSetColorF(const AColor: TColorF);
1171 begin
1172 glColor4fv(@AColor[1]);
1173 end;
1174
1175 procedure TBGLCanvas.InternalStartBlend;
1176 begin
1177 glEnable(GL_BLEND);
1178 ApplyBlendMode(BlendMode);
1179 end;
1180
1181 procedure TBGLCanvas.InternalEndBlend;
1182 begin
1183 glDisable(GL_BLEND);
1184 end;
1185
1186 procedure TBGLCanvas.InternalStartBlendTriangles;
1187 begin
1188 InternalStartBlend;
1189 glBegin(GL_TRIANGLES);
1190 end;
1191
1192 procedure TBGLCanvas.InternalStartBlendQuads;
1193 begin
1194 InternalStartBlend;
1195 glBegin(GL_QUADS);
1196 end;
1197
1198 procedure TBGLCanvas.InternalEndBlendTriangles;
1199 begin
1200 InternalEndShape;
1201 InternalEndBlend;
1202 end;
1203
1204 procedure TBGLCanvas.InternalEndBlendQuads;
1205 begin
1206 InternalEndShape;
1207 InternalEndBlend;
1208 end;
1209
1210 procedure TBGLCanvas.Fill(AColor: TBGRAPixel);
1211 begin
1212 glClearColor(AColor.Red/255, AColor.green/255, AColor.blue/255, AColor.alpha/255);
1213 glClear(GL_COLOR_BUFFER_BIT);
1214 end;
1215
1216 procedure TBGLCanvas.StartZBuffer;
1217 begin
1218 glEnable(GL_DEPTH_TEST);
1219 glClear(GL_DEPTH_BUFFER_BIT);
1220 end;
1221
1222 procedure TBGLCanvas.EndZBuffer;
1223 begin
1224 glDisable(GL_DEPTH_TEST);
1225 end;
1226
1227 procedure TBGLCanvas.WaitForGPU(AOption: TWaitForGPUOption);
1228 begin
1229 case AOption of
1230 wfgQueueAllCommands: glFlush;
1231 wfgFinishAllCommands: glFinish;
1232 end;
1233 end;
1234
TBGLCanvas.GetImagenull1235 function TBGLCanvas.GetImage(x, y, w, h: integer): TBGRACustomBitmap;
1236 begin
1237 NeedOpenGL2_0;
1238 result := BGRABitmapFactory.Create(w,h);
1239 {$PUSH}{$WARNINGS OFF}
1240 if TBGRAPixel_RGBAOrder then
1241 glReadPixels(x,self.Height-y-h, w,h, GL_RGBA, GL_UNSIGNED_BYTE, result.Data)
1242 else
1243 glReadPixels(x,self.Height-y-h, w,h, GL_BGRA, GL_UNSIGNED_BYTE, result.Data);
1244 {$POP}
1245 end;
1246
CreateFrameBuffernull1247 function TBGLCanvas.CreateFrameBuffer(AWidth, AHeight: integer): TBGLCustomFrameBuffer;
1248 begin
1249 Result:= TBGLFrameBuffer.Create(AWidth,AHeight);
1250 end;
1251
1252 procedure TBGLCanvas.EnableScissor(AValue: TRect);
1253 begin
1254 glScissor(AValue.left,Height-AValue.bottom,AValue.right-AValue.left,AValue.Bottom-AValue.Top);
1255 glEnable(GL_SCISSOR_TEST);
1256 end;
1257
1258 procedure TBGLCanvas.DisableScissor;
1259 begin
1260 glDisable(GL_SCISSOR_TEST);
1261 end;
1262
GetBlendModenull1263 function TBGLCanvas.GetBlendMode: TOpenGLBlendMode;
1264 begin
1265 result := FBlendMode;
1266 end;
1267
1268 procedure TBGLCanvas.SetBlendMode(AValue: TOpenGLBlendMode);
1269 begin
1270 FBlendMode := AValue;
1271 end;
1272
1273 procedure TBGLCanvas.SetActiveFrameBuffer(AValue: TBGLCustomFrameBuffer);
1274 var
1275 m: TMatrix4D;
1276 begin
1277 if AValue = ActiveFrameBuffer then exit;
1278 inherited SetActiveFrameBuffer(AValue);
1279 if AValue = nil then
1280 glBindFramebuffer(GL_FRAMEBUFFER, 0)
1281 else
1282 glBindFramebuffer(GL_FRAMEBUFFER, PGLuint(AValue.Handle)^);
1283
1284 glViewPort(0,0,Width,Height);
1285
1286 glMatrixMode(GL_PROJECTION);
1287 m := ProjectionMatrix;
1288 glLoadMatrixf(@m);
1289
1290 glMatrixMode(GL_MODELVIEW);
1291 m := AffineMatrixToMatrix4D(Matrix);
1292 glLoadMatrixf(@m);
1293 end;
1294
1295 destructor TBGLCanvas.Destroy;
1296 begin
1297 FLighting.Free;
1298 inherited Destroy;
1299 end;
1300
1301 { TBGLTexture }
1302
GetOpenGLMaxTexSizenull1303 function TBGLTexture.GetOpenGLMaxTexSize: integer;
1304 begin
1305 result := 0;
1306 glGetIntegerv( GL_MAX_TEXTURE_SIZE, @result );
1307 end;
1308
TBGLTexture.CreateOpenGLTexturenull1309 function TBGLTexture.CreateOpenGLTexture(ARGBAData: PLongWord;
1310 AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer;
1311 RGBAOrder: boolean): TBGLTextureHandle;
1312 var p: POpenGLTexture;
1313 providedFormat: GLenum;
1314 begin
1315 if RGBAOrder then providedFormat:= GL_RGBA else providedFormat:= GL_BGRA;
1316 New(p);
1317 p^.AllocatedWidth := AAllocatedWidth;
1318 p^.AllocatedHeight := AAllocatedHeight;
1319 p^.ActualWidth := AActualWidth;
1320 p^.ActualHeight := AActualHeight;
1321
1322 glGenTextures( 1, @p^.ID );
1323 glBindTexture( GL_TEXTURE_2D, p^.ID );
1324 glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR );
1325 glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR );
1326 glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, AAllocatedWidth, AAllocatedHeight, 0, providedFormat, GL_UNSIGNED_BYTE, ARGBAData );
1327 result := p;
1328 end;
1329
1330 procedure TBGLTexture.UpdateOpenGLTexture(ATexture: TBGLTextureHandle;
1331 ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth,
1332 AActualHeight: integer; RGBAOrder: boolean);
1333 var providedFormat: GLenum;
1334 begin
1335 if RGBAOrder then providedFormat:= GL_RGBA else providedFormat:= GL_BGRA;
1336 SetOpenGLTextureSize(ATexture, AAllocatedWidth,AAllocatedHeight, AActualWidth,AActualHeight);
1337 glBindTexture( GL_TEXTURE_2D, TOpenGLTexture(ATexture^).ID );
1338 glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, AAllocatedWidth, AAllocatedHeight, 0, providedFormat, GL_UNSIGNED_BYTE, ARGBAData );
1339 end;
1340
TBGLTexture.SupportsBGRAOrdernull1341 class function TBGLTexture.SupportsBGRAOrder: boolean;
1342 begin
1343 Result:= true;
1344 end;
1345
1346 procedure TBGLTexture.SetOpenGLTextureSize(ATexture: TBGLTextureHandle;
1347 AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer);
1348 begin
1349 with TOpenGLTexture(ATexture^) do
1350 begin
1351 ActualWidth := AActualWidth;
1352 ActualHeight:= AActualHeight;
1353 AllocatedWidth := AAllocatedWidth;
1354 AllocatedHeight := AAllocatedHeight;
1355 end;
1356 end;
1357
1358 procedure TBGLTexture.ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle;
1359 FramesX: Integer; FramesY: Integer);
1360 var U,V: Single;
1361 tX, tY, fU, fV : Single;
1362 ix,iy,i: Integer;
1363 begin
1364 with TOpenGLTexture(ATexture^) do
1365 begin
1366 if AllocatedWidth = 0 then
1367 U := 1
1368 else
1369 U := ActualWidth/AllocatedWidth;
1370 if AllocatedHeight = 0 then
1371 V := 1
1372 else
1373 V := ActualHeight/AllocatedHeight;
1374
1375 if FramesX < 1 then FramesX := 1;
1376 if FramesY < 1 then FramesY := 1;
1377
1378 SetLength( FramesCoord, FramesX * FramesY + 1 );
1379 fU := U / FramesX;
1380 fV := V / FramesY;
1381
1382 FramesCoord[ 0, 0 ].X := 0;
1383 FramesCoord[ 0, 0 ].Y := 0;
1384 FramesCoord[ 0, 1 ].X := U;
1385 FramesCoord[ 0, 1 ].Y := 0;
1386 FramesCoord[ 0, 2 ].X := U;
1387 FramesCoord[ 0, 2 ].Y := V;
1388 FramesCoord[ 0, 3 ].X := 0;
1389 FramesCoord[ 0, 3 ].Y := V;
1390
1391 ix := 1;
1392 iy := 1;
1393 for i := 1 to FramesX * FramesY do
1394 begin
1395 tX := ix * fU;
1396 tY := iy * fV;
1397
1398 FramesCoord[ i, 0 ].X := tX - fU;
1399 FramesCoord[ i, 0 ].Y := tY - fV;
1400
1401 FramesCoord[ i, 1 ].X := tX;
1402 FramesCoord[ i, 1 ].Y := tY - fV;
1403
1404 FramesCoord[ i, 2 ].X := tX;
1405 FramesCoord[ i, 2 ].Y := tY;
1406
1407 FramesCoord[ i, 3 ].X := tX - fU;
1408 FramesCoord[ i, 3 ].Y := tY;
1409
1410 inc(ix);
1411 if ix > FramesX then
1412 begin
1413 ix := 1;
1414 inc(iy);
1415 end;
1416 end;
1417
1418 end;
1419 end;
1420
GetOpenGLFrameCountnull1421 function TBGLTexture.GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer;
1422 begin
1423 if ATexture = nil then
1424 result := 0
1425 else
1426 begin
1427 result := Length(TOpenGLTexture(ATexture^).FramesCoord);
1428 if result > 0 then dec(result); //first frame is whole picture
1429 end;
1430 end;
1431
GetEmptyTexturenull1432 function TBGLTexture.GetEmptyTexture: TBGLTextureHandle;
1433 begin
1434 result := nil;
1435 end;
1436
1437 procedure TBGLTexture.FreeOpenGLTexture(ATexture: TBGLTextureHandle);
1438 begin
1439 glDeleteTextures( 1, @TOpenGLTexture(ATexture^).ID );
1440 Dispose(POpenGLTexture(ATexture));
1441 end;
1442
1443 procedure TBGLTexture.UpdateGLResampleFilter(ATexture: TBGLTextureHandle;
1444 AFilter: TOpenGLResampleFilter);
1445 begin
1446 glBindTexture( GL_TEXTURE_2D, TOpenGLTexture(ATexture^).ID );
1447 if AFilter = orfLinear then
1448 begin
1449 glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR );
1450 glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR );
1451 end else
1452 begin
1453 glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST );
1454 glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST );
1455 end;
1456 end;
1457
1458 procedure TBGLTexture.InternalSetColor(const AColor: TBGRAPixel);
1459 begin
1460 {$PUSH}{$WARNINGS OFF}
1461 if TBGRAPixel_RGBAOrder then
1462 glColor4ubv(@AColor)
1463 else
1464 glColor4ub(AColor.red,AColor.green,AColor.blue,AColor.alpha);
1465 {$POP}
1466 end;
1467
1468 procedure TBGLTexture.DoDrawTriangleOrQuad(const APoints: array of TPointF;
1469 const APointsZ: array of Single; const APoints3D: array of TPoint3D_128;
1470 const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF;
1471 const AColors: array of TColorF);
1472 var
1473 i: Integer;
1474 factorX,factorY: single;
1475 begin
1476 if (FOpenGLTexture = nil) or (Width = 0) or (Height = 0) then exit;
1477 with TOpenGLTexture(FOpenGLTexture^) do
1478 begin
1479 glEnable( GL_BLEND );
1480
1481 glEnable( GL_TEXTURE_2D );
1482 glBindTexture( GL_TEXTURE_2D, ID );
1483
1484 if FIsMask then
1485 begin
1486 glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB );
1487 glTexEnvi( GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_REPLACE );
1488 glTexEnvi( GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PRIMARY_COLOR_ARB );
1489 end else
1490 glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE );
1491
1492 ApplyBlendMode(BlendMode);
1493
1494 factorX := 1/Width;
1495 factorY := 1/Height;
1496
1497 if length(AColors) = 0 then
1498 glColor4f(1,1,1,1);
1499
1500 if length(APoints3D) <> 0 then
1501 begin
1502 if length(APoints3D) = 3 then
1503 glBegin( GL_TRIANGLES )
1504 else
1505 glBegin( GL_QUADS );
1506
1507 for i := 0 to high(APoints3D) do
1508 begin
1509 if length(AColors) <> 0 then glColor4fv( @AColors[i] );
1510 glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY );
1511 if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] );
1512 glVertex3fv( @APoints3D[i] );
1513 end;
1514 end else
1515 begin
1516 if length(APoints) = 3 then
1517 glBegin( GL_TRIANGLES )
1518 else
1519 glBegin( GL_QUADS );
1520
1521 if length(APointsZ) <> 0 then
1522 begin
1523 for i := 0 to high(APoints) do
1524 begin
1525 if length(AColors) <> 0 then glColor4fv( @AColors[i] );
1526 glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY );
1527 if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] );
1528 glVertex3f( APoints[i].x, APoints[i].y, APointsZ[i] );
1529 end;
1530 end else
1531 begin
1532 for i := 0 to high(APoints) do
1533 begin
1534 if length(AColors) <> 0 then glColor4fv( @AColors[i] );
1535 glTexCoord2f( (ATexCoords[i].x+0.5)*factorX, (ATexCoords[i].y+0.5)*factorY );
1536 if length(ANormals3D) <> 0 then glNormal3fv( @ANormals3D[i] );
1537 glVertex2fv( @APoints[i] );
1538 end;
1539 end;
1540 end;
1541
1542 glEnd;
1543 glDisable( GL_TEXTURE_2D );
1544 glDisable( GL_BLEND );
1545 end;
1546 end;
1547
1548 procedure TBGLTexture.DoDraw(pt1, pt2, pt3, pt4: TPointF; AColor: TBGRAPixel);
1549 type
1550 TTexCoordIndex = array[0..3] of integer;
1551 const
1552 FLIP_TEXCOORD : array[ 0..3 ] of TTexCoordIndex = ( ( 0, 1, 2, 3 ), ( 1, 0, 3, 2 ), ( 3, 2, 1, 0 ), ( 2, 3, 0, 1 ) );
1553 var
1554 coordFlip: TTexCoordIndex;
1555 begin
1556 if (FOpenGLTexture = nil) or (FFrame < 0) or (FFrame > FrameCount) then exit;
1557 with TOpenGLTexture(FOpenGLTexture^) do
1558 begin
1559 glEnable( GL_BLEND );
1560 glEnable( GL_TEXTURE_2D );
1561 glBindTexture( GL_TEXTURE_2D, ID );
1562
1563 if FIsMask then
1564 begin
1565 glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB );
1566 glTexEnvi( GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_REPLACE );
1567 glTexEnvi( GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PRIMARY_COLOR_ARB );
1568 end else
1569 glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE );
1570
1571 ApplyBlendMode(BlendMode);
1572
1573 coordFlip := FLIP_TEXCOORD[ Integer(FFlipX) + Integer(FFlipY)*2 ];
1574
1575 glBegin( GL_QUADS );
1576
1577 if GradientColors then
1578 InternalSetColor(FGradTopLeft)
1579 else
1580 InternalSetColor(AColor);
1581
1582 glTexCoord2fv( @FramesCoord[FFrame,coordFlip[0]] );
1583 glVertex2fv( @pt1 );
1584
1585 if GradientColors then
1586 InternalSetColor(FGradTopRight);
1587
1588 glTexCoord2fv( @FramesCoord[FFrame,coordFlip[1]] );
1589 glVertex2fv( @pt2 );
1590
1591 if GradientColors then
1592 InternalSetColor(FGradBottomRight);
1593
1594 glTexCoord2fv( @FramesCoord[FFrame,coordFlip[2]] );
1595 glVertex2fv( @pt3 );
1596
1597 if GradientColors then
1598 InternalSetColor(FGradBottomLeft);
1599
1600 glTexCoord2fv( @FramesCoord[FFrame,coordFlip[3]] );
1601 glVertex2fv( @pt4 );
1602
1603 glEnd;
1604 glDisable( GL_TEXTURE_2D );
1605 glDisable( GL_BLEND );
1606 end;
1607 end;
1608
1609 procedure TBGLTexture.DoStretchDraw(x, y, w, h: single; AColor: TBGRAPixel);
1610 begin
1611 DoDraw(PointF(x, y), PointF(x+w, y), PointF(x+w, y+h), PointF(x, y+h), AColor);
1612 end;
1613
1614 procedure TBGLTexture.DoStretchDrawAngle(x, y, w, h, angleDeg: single;
1615 rotationCenter: TPointF; AColor: TBGRAPixel);
1616 var
1617 m : TAffineMatrix;
1618 begin
1619 m := AffineMatrixTranslation(rotationCenter.X,rotationCenter.Y)*
1620 AffineMatrixRotationDeg(angleDeg)*
1621 AffineMatrixTranslation(-rotationCenter.X,-rotationCenter.Y);
1622 DoDraw(m*PointF(x, y), m*PointF(x+w, y), m*PointF(x+w, y+h), m*PointF(x, y+h), AColor);
1623 end;
1624
1625 procedure TBGLTexture.DoDrawAffine(Origin, HAxis, VAxis: TPointF;
1626 AColor: TBGRAPixel);
1627 begin
1628 DoDraw(Origin, HAxis, HAxis+(VAxis-Origin), VAxis, AColor);
1629 end;
1630
1631 procedure TBGLTexture.ToggleFlipX;
1632 begin
1633 FFlipX := not FFlipX;
1634 end;
1635
1636 procedure TBGLTexture.ToggleFlipY;
1637 begin
1638 FFlipY := not FFlipY;
1639 end;
1640
1641 procedure TBGLTexture.Bind(ATextureNumber: integer);
1642 begin
1643 if (ATextureNumber < 0) or (ATextureNumber > 31) then
1644 raise exception.Create('Texture number out of bounds');
1645 if (glActiveTexture = nil) then
1646 begin
1647 if not Load_GL_version_1_3 then
1648 raise exception.Create('Cannot load OpenGL 1.3');
1649 end;
1650 glActiveTexture(GL_TEXTURE0 + ATextureNumber);
1651 glBindTexture(GL_TEXTURE_2D, POpenGLTexture(FOpenGLTexture)^.ID);
1652 if ATextureNumber<>0 then
1653 glActiveTexture(GL_TEXTURE0);
1654 end;
1655
TBGLTexture.FilterBlurMotionnull1656 function TBGLTexture.FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture;
1657 var shader: TBGLCustomShader;
1658 blurName: string;
1659 begin
1660 blurName := 'TBGLBlurShader(' + RadialBlurTypeToStr[ABlurType] + ')';
1661 shader := BGLCanvas.Lighting.Shader[blurName];
1662 if shader = nil then
1663 begin
1664 shader := TBGLBlurShader.Create(BGLCanvas, ABlurType);
1665 BGLCanvas.Lighting.Shader[blurName] := shader;
1666 end;
1667 with (shader as TBGLBlurShader) do
1668 begin
1669 Radius := ARadius;
1670 Direction := ADirection;
1671 result := FilterBlurMotion(self);
1672 end;
1673 end;
1674
TBGLTexture.FilterBlurRadialnull1675 function TBGLTexture.FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture;
1676 var shader: TBGLCustomShader;
1677 blurName: String;
1678 begin
1679 blurName := 'TBGLBlurShader(' + RadialBlurTypeToStr[ABlurType] + ')';
1680 shader := BGLCanvas.Lighting.Shader[blurName];
1681 if shader = nil then
1682 begin
1683 shader := TBGLBlurShader.Create(BGLCanvas, ABlurType);
1684 BGLCanvas.Lighting.Shader[blurName] := shader;
1685 end;
1686 with (shader as TBGLBlurShader) do
1687 begin
1688 Radius := ARadius;
1689 result := FilterBlurRadial(self);
1690 end;
1691 end;
1692
1693 procedure TBGLTexture.Init(ATexture: TBGLTextureHandle; AWidth,
1694 AHeight: integer; AOwned: boolean);
1695 begin
1696 inherited Init(ATexture, AWidth, AHeight, AOwned);
1697 FFlipX := false;
1698 FFlipY := false;
1699 FBlendMode := obmNormal;
1700 end;
1701
1702 procedure TBGLTexture.NotifyInvalidFrameSize;
1703 begin
1704 raise exception.Create('Invalid frame size');
1705 end;
1706
1707 procedure TBGLTexture.NotifyErrorLoadingFile(AFilenameUTF8: string);
1708 begin
1709 raise exception.Create('Error loading file "'+AFilenameUTF8+'"');
1710 end;
1711
NewEmptynull1712 function TBGLTexture.NewEmpty: TBGLCustomTexture;
1713 begin
1714 result := TBGLTexture.Create;
1715 end;
1716
NewFromTexturenull1717 function TBGLTexture.NewFromTexture(ATexture: TBGLTextureHandle; AWidth,
1718 AHeight: integer): TBGLCustomTexture;
1719 begin
1720 result := TBGLTexture.Create(ATexture,AWidth,AHeight);
1721 end;
1722
Duplicatenull1723 function TBGLTexture.Duplicate: TBGLCustomTexture;
1724 begin
1725 Result:= inherited Duplicate;
1726 TBGLTexture(result).FFlipX := FFlipX;
1727 TBGLTexture(result).FFlipY := FFlipY;
1728 end;
1729
1730 { TBGLBitmap }
1731
GetOpenGLMaxTexSizenull1732 function TBGLBitmap.GetOpenGLMaxTexSize: integer;
1733 begin
1734 result := 0;
1735 glGetIntegerv( GL_MAX_TEXTURE_SIZE, @result );
1736 end;
1737
TBGLBitmap.NewBitmapnull1738 function TBGLBitmap.NewBitmap: TBGLBitmap;
1739 begin
1740 Result:=inherited NewBitmap as TBGLBitmap;
1741 end;
1742
TBGLBitmap.NewBitmapnull1743 function TBGLBitmap.NewBitmap(AWidth, AHeight: integer): TBGLBitmap;
1744 begin
1745 Result:=inherited NewBitmap(AWidth, AHeight) as TBGLBitmap;
1746 end;
1747
TBGLBitmap.NewBitmapnull1748 function TBGLBitmap.NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel
1749 ): TBGLBitmap;
1750 begin
1751 Result:=inherited NewBitmap(AWidth, AHeight, Color) as TBGLBitmap;
1752 end;
1753
TBGLBitmap.NewBitmapnull1754 function TBGLBitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer
1755 ): TBGLBitmap;
1756 begin
1757 Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TBGLBitmap;
1758 end;
1759
TBGLBitmap.NewBitmapnull1760 function TBGLBitmap.NewBitmap(Filename: string): TBGLBitmap;
1761 begin
1762 Result:=inherited NewBitmap(Filename) as TBGLBitmap;
1763 end;
1764
TBGLBitmap.NewBitmapnull1765 function TBGLBitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGLBitmap;
1766 begin
1767 Result:=inherited NewBitmap(Filename, AIsUtf8) as TBGLBitmap;
1768 end;
1769
TBGLBitmap.NewBitmapnull1770 function TBGLBitmap.NewBitmap(Filename: string; AIsUtf8: boolean;
1771 AOptions: TBGRALoadingOptions): TBGLBitmap;
1772 begin
1773 Result:=inherited NewBitmap(Filename, AIsUtf8, AOptions) as TBGLBitmap;
1774 end;
1775
TBGLBitmap.NewBitmapnull1776 function TBGLBitmap.NewBitmap(AFPImage: TFPCustomImage): TBGLBitmap;
1777 begin
1778 Result:=inherited NewBitmap(AFPImage) as TBGLBitmap;
1779 end;
1780
NewReferencenull1781 function TBGLBitmap.NewReference: TBGLBitmap;
1782 begin
1783 Result:=inherited NewReference as TBGLBitmap;
1784 end;
1785
TBGLBitmap.GetUniquenull1786 function TBGLBitmap.GetUnique: TBGLBitmap;
1787 begin
1788 Result:=inherited GetUnique as TBGLBitmap;
1789 end;
1790
Duplicatenull1791 function TBGLBitmap.Duplicate(DuplicateProperties: Boolean): TBGLBitmap;
1792 begin
1793 Result:=inherited Duplicate(DuplicateProperties) as TBGLBitmap;
1794 end;
1795
Duplicatenull1796 function TBGLBitmap.Duplicate(DuplicateProperties, DuplicateXorMask: Boolean): TBGLBitmap;
1797 begin
1798 Result:=inherited Duplicate(DuplicateProperties, DuplicateXorMask) as TBGLBitmap;
1799 end;
1800
GetPartnull1801 function TBGLBitmap.GetPart(const ARect: TRect): TBGLBitmap;
1802 begin
1803 Result:=inherited GetPart(ARect) as TBGLBitmap;
1804 end;
1805
CreateBrushTexturenull1806 function TBGLBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor,
1807 ABackgroundColor: TBGRAPixel; AWidth: integer; AHeight: integer;
1808 APenWidth: single): TBGLBitmap;
1809 begin
1810 Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor,
1811 ABackgroundColor, AWidth, AHeight, APenWidth) as TBGLBitmap;
1812 end;
1813
Resamplenull1814 function TBGLBitmap.Resample(newWidth, newHeight: integer; mode: TResampleMode
1815 ): TBGLBitmap;
1816 begin
1817 Result:=inherited Resample(newWidth, newHeight, mode) as TBGLBitmap;
1818 end;
1819
FilterSmartZoom3null1820 function TBGLBitmap.FilterSmartZoom3(Option: TMedianOption): TBGLBitmap;
1821 begin
1822 Result:=inherited FilterSmartZoom3(Option) as TBGLBitmap;
1823 end;
1824
TBGLBitmap.FilterMediannull1825 function TBGLBitmap.FilterMedian(Option: TMedianOption): TBGLBitmap;
1826 begin
1827 Result:=inherited FilterMedian(Option) as TBGLBitmap;
1828 end;
1829
FilterSmoothnull1830 function TBGLBitmap.FilterSmooth: TBGLBitmap;
1831 begin
1832 Result:=inherited FilterSmooth as TBGLBitmap;
1833 end;
1834
FilterSharpennull1835 function TBGLBitmap.FilterSharpen(Amount: single): TBGLBitmap;
1836 begin
1837 Result:=inherited FilterSharpen(Amount) as TBGLBitmap;
1838 end;
1839
FilterSharpennull1840 function TBGLBitmap.FilterSharpen(ABounds: TRect; Amount: single): TBGLBitmap;
1841 begin
1842 Result:=inherited FilterSharpen(ABounds, Amount) as TBGLBitmap;
1843 end;
1844
TBGLBitmap.FilterContournull1845 function TBGLBitmap.FilterContour(AGammaCorrection: boolean = false): TBGLBitmap;
1846 begin
1847 Result:=inherited FilterContour(AGammaCorrection) as TBGLBitmap;
1848 end;
1849
FilterPixelatenull1850 function TBGLBitmap.FilterPixelate(pixelSize: integer; useResample: boolean;
1851 filter: TResampleFilter): TBGLBitmap;
1852 begin
1853 Result:=inherited FilterPixelate(pixelSize, useResample, filter) as TBGLBitmap;
1854 end;
1855
TBGLBitmap.FilterBlurRadialnull1856 function TBGLBitmap.FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGLBitmap;
1857 begin
1858 Result:=inherited FilterBlurRadial(radius, blurType) as TBGLBitmap;
1859 end;
1860
TBGLBitmap.FilterBlurRadialnull1861 function TBGLBitmap.FilterBlurRadial(const ABounds: TRect; radius: single;
1862 blurType: TRadialBlurType): TBGLBitmap;
1863 begin
1864 Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TBGLBitmap;
1865 end;
1866
TBGLBitmap.FilterBlurRadialnull1867 function TBGLBitmap.FilterBlurRadial(radiusX, radiusY: single;
1868 blurType: TRadialBlurType): TBGLBitmap;
1869 begin
1870 Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TBGLBitmap;
1871 end;
1872
TBGLBitmap.FilterBlurRadialnull1873 function TBGLBitmap.FilterBlurRadial(const ABounds: TRect; radiusX,
1874 radiusY: single; blurType: TRadialBlurType): TBGLBitmap;
1875 begin
1876 Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TBGLBitmap;
1877 end;
1878
FilterBlurMotionnull1879 function TBGLBitmap.FilterBlurMotion(distance: single; angle: single;
1880 oriented: boolean): TBGLBitmap;
1881 begin
1882 Result:=inherited FilterBlurMotion(distance, angle, oriented) as TBGLBitmap;
1883 end;
1884
FilterBlurMotionnull1885 function TBGLBitmap.FilterBlurMotion(const ABounds: TRect; distance: single;
1886 angle: single; oriented: boolean): TBGLBitmap;
1887 begin
1888 Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TBGLBitmap;
1889 end;
1890
FilterCustomBlurnull1891 function TBGLBitmap.FilterCustomBlur(mask: TCustomUniversalBitmap): TBGLBitmap;
1892 begin
1893 Result:=inherited FilterCustomBlur(mask) as TBGLBitmap;
1894 end;
1895
FilterCustomBlurnull1896 function TBGLBitmap.FilterCustomBlur(const ABounds: TRect;
1897 mask: TCustomUniversalBitmap): TBGLBitmap;
1898 begin
1899 Result:=inherited FilterCustomBlur(ABounds, mask) as TBGLBitmap;
1900 end;
1901
FilterEmbossnull1902 function TBGLBitmap.FilterEmboss(angle: single; AStrength: integer;
1903 AOptions: TEmbossOptions): TBGLBitmap;
1904 begin
1905 Result:=inherited FilterEmboss(angle, AStrength, AOptions) as TBGLBitmap;
1906 end;
1907
FilterEmbossnull1908 function TBGLBitmap.FilterEmboss(angle: single; ABounds: TRect;
1909 AStrength: integer; AOptions: TEmbossOptions): TBGLBitmap;
1910 begin
1911 Result:=inherited FilterEmboss(angle, ABounds, AStrength, AOptions) as TBGLBitmap;
1912 end;
1913
FilterEmbossHighlightnull1914 function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean): TBGLBitmap;
1915 begin
1916 Result:=inherited FilterEmbossHighlight(FillSelection) as TBGLBitmap;
1917 end;
1918
FilterEmbossHighlightnull1919 function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean;
1920 BorderColor: TBGRAPixel): TBGLBitmap;
1921 begin
1922 Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor) as TBGLBitmap;
1923 end;
1924
FilterEmbossHighlightnull1925 function TBGLBitmap.FilterEmbossHighlight(FillSelection: boolean;
1926 BorderColor: TBGRAPixel; var Offset: TPoint): TBGLBitmap;
1927 begin
1928 Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor, Offset) as TBGLBitmap;
1929 end;
1930
TBGLBitmap.FilterGrayscalenull1931 function TBGLBitmap.FilterGrayscale: TBGLBitmap;
1932 begin
1933 Result:=inherited FilterGrayscale as TBGLBitmap;
1934 end;
1935
TBGLBitmap.FilterGrayscalenull1936 function TBGLBitmap.FilterGrayscale(ABounds: TRect): TBGLBitmap;
1937 begin
1938 Result:=inherited FilterGrayscale(ABounds) as TBGLBitmap;
1939 end;
1940
TBGLBitmap.FilterNormalizenull1941 function TBGLBitmap.FilterNormalize(eachChannel: boolean): TBGLBitmap;
1942 begin
1943 Result:=inherited FilterNormalize(eachChannel) as TBGLBitmap;
1944 end;
1945
TBGLBitmap.FilterNormalizenull1946 function TBGLBitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean
1947 ): TBGLBitmap;
1948 begin
1949 Result:=inherited FilterNormalize(ABounds, eachChannel) as TBGLBitmap;
1950 end;
1951
FilterRotatenull1952 function TBGLBitmap.FilterRotate(origin: TPointF; angle: single;
1953 correctBlur: boolean): TBGLBitmap;
1954 begin
1955 Result:=inherited FilterRotate(origin, angle, correctBlur) as TBGLBitmap;
1956 end;
1957
FilterAffinenull1958 function TBGLBitmap.FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean
1959 ): TBGLBitmap;
1960 begin
1961 Result:=inherited FilterAffine(AMatrix, correctBlur) as TBGLBitmap;
1962 end;
1963
FilterSpherenull1964 function TBGLBitmap.FilterSphere: TBGLBitmap;
1965 begin
1966 Result:=inherited FilterSphere as TBGLBitmap;
1967 end;
1968
FilterTwirlnull1969 function TBGLBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single;
1970 ATurn: Single; AExponent: Single): TBGLBitmap;
1971 begin
1972 Result:=inherited FilterTwirl(ACenter, ARadius, ATurn, AExponent) as TBGLBitmap;
1973 end;
1974
FilterTwirlnull1975 function TBGLBitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint;
1976 ARadius: Single; ATurn: Single; AExponent: Single): TBGLBitmap;
1977 begin
1978 Result:=inherited FilterTwirl(ABounds, ACenter, ARadius, ATurn, AExponent) as TBGLBitmap;
1979 end;
1980
FilterCylindernull1981 function TBGLBitmap.FilterCylinder: TBGLBitmap;
1982 begin
1983 Result:=inherited FilterCylinder as TBGLBitmap;
1984 end;
1985
FilterPlanenull1986 function TBGLBitmap.FilterPlane: TBGLBitmap;
1987 begin
1988 Result:=inherited FilterPlane as TBGLBitmap;
1989 end;
1990
1991 initialization
1992
1993 BGLBitmapFactory := TBGLBitmap;
1994 BGLTextureFactory := TBGLTexture;
1995 BGRASpriteGL.BGLSpriteEngine := TBGLDefaultSpriteEngine.Create;
1996 BGLCanvasInstance := TBGLCanvas.Create;
1997
1998 finalization
1999
2000 BGLCanvasInstance.Free;
2001 BGLCanvasInstance := nil;
2002 BGRASpriteGL.BGLSpriteEngine.Free;
2003 BGRASpriteGL.BGLSpriteEngine := nil;
2004
2005 end.
2006
2007