* added SDL support
[glBitmap.git] / glBitmap.pas
1 {***********************************************************
2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
4 ------------------------------------------------------------
5 The contents of this file are used with permission, subject to
6 the Mozilla Public License Version 1.1 (the "License"); you may
7 not use this file except in compliance with the License. You may
8 obtain a copy of the License at
9 http://www.mozilla.org/MPL/MPL-1.1.html
10 ------------------------------------------------------------
11 Version 2.0.3
12 ------------------------------------------------------------
13 History
14 21-03-2010
15 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
16   then it's your problem if that isn't true. This prevents the unit for incompatibility
17   with newer versions of Delphi.
18 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
19 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
20 10-08-2008
21 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
22 - Additional Datapointer for functioninterface now has the name CustomData  
23 24-07-2008
24 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
25 - If you load an texture from an file the property Filename will be set to the name of the file
26 - Three new properties to attach custom data to the Texture objects
27   - CustomName  (free for use string)
28   - CustomNameW (free for use widestring)
29   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
30 27-05-2008
31 - RLE TGAs loaded much faster
32 26-05-2008
33 - fixed some problem with reading RLE TGAs.
34 21-05-2008
35 - function clone now only copys data if it's assigned and now it also copies the ID
36 - it seems that lazarus dont like comments in comments.
37 01-05-2008
38 - It's possible to set the id of the texture
39 - define GLB_NO_NATIVE_GL deactivated by default
40 27-04-2008
41 - Now supports the following libraries
42   - SDL and SDL_image
43   - libPNG
44   - libJPEG
45 - Linux compatibillity via free pascal compatibility (delphi sources optional)
46 - BMPs now loaded manuel
47 - Large restructuring
48 - Property DataPtr now has the name Data
49 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
50 - Unused Depth removed
51 - Function FreeData to freeing image data added 
52 24-10-2007
53 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
54 15-11-2006
55 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
56 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
57 - Function ReadOpenGLExtension is now only intern
58 29-06-2006
59 - pngimage now disabled by default like all other versions.
60 26-06-2006
61 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
62 22-06-2006
63 - Fixed some Problem with Delphi 5
64 - Now uses the newest version of pngimage. Makes saving pngs much easier.
65 22-03-2006
66 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
67 09-03-2006
68 - Internal Format ifDepth8 added
69 - function GrabScreen now supports all uncompressed formats
70 31-01-2006
71 - AddAlphaFromglBitmap implemented
72 29-12-2005
73 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
74 28-12-2005
75 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
76   property Width, Height, Depth are still existing and new property Dimension are avail
77 11-12-2005
78 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
79 19-10-2005
80 - Added function GrabScreen to class TglBitmap2D
81 18-10-2005
82 - Added support to Save images
83 - Added function Clone to Clone Instance
84 11-10-2005
85 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
86   Usefull for Future
87 - Several speed optimizations
88 09-10-2005
89 - Internal structure change. Loading of TGA, PNG and DDS improved.
90   Data, format and size will now set directly with SetDataPtr.
91 - AddFunc now works with all Types of Images and Formats
92 - Some Funtions moved to Baseclass TglBitmap
93 06-10-2005
94 - Added Support to decompress DXT3 and DXT5 compressed Images.
95 - Added Mapping to convert data from one format into an other.
96 05-10-2005
97 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
98   supported Input format (supported by GetPixel) into any uncompresed Format
99 - Added Support to decompress DXT1 compressed Images.
100 - SwapColors replaced by ConvertTo
101 04-10-2005
102 - Added Support for compressed DDSs
103 - Added new internal formats (DXT1, DXT3, DXT5)
104 29-09-2005
105 - Parameter Components renamed to InternalFormat
106 23-09-2005
107 - Some AllocMem replaced with GetMem (little speed change)
108 - better exception handling. Better protection from memory leaks.
109 22-09-2005
110 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
111 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
112 07-09-2005
113 - Added support for Grayscale textures
114 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
115 10-07-2005
116 - Added support for GL_VERSION_2_0
117 - Added support for GL_EXT_texture_filter_anisotropic
118 04-07-2005
119 - Function FillWithColor fills the Image with one Color
120 - Function LoadNormalMap added
121 30-06-2005
122 - ToNormalMap allows to Create an NormalMap from the Alphachannel
123 - ToNormalMap now supports Sobel (nmSobel) function.
124 29-06-2005
125 - support for RLE Compressed RGB TGAs added
126 28-06-2005
127 - Class TglBitmapNormalMap added to support Normalmap generation
128 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
129   3 Filters are supported. (4 Samples, 3x3 and 5x5)
130 16-06-2005
131 - Method LoadCubeMapClass removed
132 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
133 - virtual abstract method GenTexture in class TglBitmap now is protected
134 12-06-2005
135 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
136 10-06-2005
137 - little enhancement for IsPowerOfTwo
138 - TglBitmap1D.GenTexture now tests NPOT Textures
139 06-06-2005
140 - some little name changes. All properties or function with Texture in name are
141   now without texture in name. We have allways texture so we dosn't name it.
142 03-06-2005
143 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
144   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
145 02-06-2005
146 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
147 25-04-2005
148 - Function Unbind added
149 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
150 21-04-2005
151 - class TglBitmapCubeMap added (allows to Create Cubemaps)
152 29-03-2005
153 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
154   To Enable png's use the define pngimage
155 22-03-2005
156 - New Functioninterface added
157 - Function GetPixel added
158 27-11-2004
159 - Property BuildMipMaps renamed to MipMap
160 21-11-2004
161 - property Name removed.
162 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
163 22-05-2004
164 - property name added. Only used in glForms!
165 26-11-2003
166 - property FreeDataAfterGenTexture is now available as default (default = true)
167 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
168 - function MoveMemory replaced with function Move (little speed change)
169 - several calculations stored in variables (little speed change)
170 29-09-2003
171 - property BuildMipsMaps added (default = true)
172   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
173 - property FreeDataAfterGenTexture added (default = true)
174   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
175 - parameter DisableOtherTextureUnits of Bind removed
176 - parameter FreeDataAfterGeneration of GenTextures removed
177 12-09-2003
178 - TglBitmap dosn't delete data if class was destroyed (fixed)
179 09-09-2003
180 - Bind now enables TextureUnits (by params)
181 - GenTextures can leave data (by param)
182 - LoadTextures now optimal
183 03-09-2003
184 - Performance optimization in AddFunc
185 - procedure Bind moved to subclasses
186 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
187 19-08-2003
188 - Texturefilter and texturewrap now also as defaults
189   Minfilter = GL_LINEAR_MIPMAP_LINEAR
190   Magfilter = GL_LINEAR
191   Wrap(str) = GL_CLAMP_TO_EDGE
192 - Added new format tfCompressed to create a compressed texture.
193 - propertys IsCompressed, TextureSize and IsResident added
194   IsCompressed and TextureSize only contains data from level 0
195 18-08-2003
196 - Added function AddFunc to add PerPixelEffects to Image
197 - LoadFromFunc now based on AddFunc
198 - Invert now based on AddFunc
199 - SwapColors now based on AddFunc
200 16-08-2003
201 - Added function FlipHorz
202 15-08-2003
203 - Added function LaodFromFunc to create images with function
204 - Added function FlipVert
205 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
206 29-07-2003
207 - Added Alphafunctions to calculate alpha per function
208 - Added Alpha from ColorKey using alphafunctions
209 28-07-2003
210 - First full functionally Version of glBitmap
211 - Support for 24Bit and 32Bit TGA Pictures added
212 25-07-2003
213 - begin of programming
214 ***********************************************************}
215 unit glBitmap;
216
217 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
218 // Please uncomment the defines below to configure the glBitmap to your preferences.
219 // If you have configured the unit you can uncomment the warning above.
220
221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
222 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
224 // activate to enable build-in OpenGL support with statically linked methods
225 // use dglOpenGL.pas if not enabled
226 {.$DEFINE GLB_NATIVE_OGL_STATIC}
227
228 // activate to enable build-in OpenGL support with dynamically linked methods
229 // use dglOpenGL.pas if not enabled
230 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
231
232 // activate to enable the support for SDL_surfaces
233 {$DEFINE GLB_SDL}
234
235 // activate  to enable the support for TBitmap from Delphi (not lazarus)
236 {.$DEFINE GLB_DELPHI}
237
238
239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
240 // activate to enable the support of SDL_image to load files. (READ ONLY)
241 // If you enable SDL_image all other libraries will be ignored!
242 {$DEFINE GLB_SDL_IMAGE}
243
244 // activate to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
245 // if you enable pngimage the libPNG will be ignored
246 {.$DEFINE GLB_PNGIMAGE}
247
248 // activate to use the libPNG http://www.libpng.org/
249 // You will need an aditional header.
250 // http://www.opengl24.de/index.php?cat=header&file=libpng
251 {.$DEFINE GLB_LIB_PNG}
252
253 // if you enable delphi jpegs the libJPEG will be ignored
254 {.$DEFINE GLB_DELPHI_JPEG}
255
256 // activateto use the libJPEG http://www.ijg.org/
257 // You will need an aditional header.
258 // http://www.opengl24.de/index.php?cat=header&file=libjpeg
259 {.$DEFINE GLB_LIB_JPEG}
260
261
262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
263 // PRIVATE: DO not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
265 // Delphi Versions
266 {$IFDEF fpc}
267   {$MODE Delphi}
268
269   {$IFDEF CPUI386}
270     {$DEFINE CPU386}
271     {$ASMMODE INTEL}
272   {$ENDIF}
273
274   {$IFNDEF WINDOWS}
275     {$linklib c}
276   {$ENDIF}
277 {$ENDIF}
278
279 // Operation System
280 {$IF DEFINED(WIN32) or DEFINED(WIN64)}
281   {$DEFINE GLB_WIN}
282 {$ELSEIF DEFINED(LINUX)}
283   {$DEFINE GLB_LINUX}
284 {$IFEND}
285
286 // native OpenGL Support
287 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
288   {$DEFINE GLB_NATIVE_OGL}
289 {$IFEND}
290
291 // checking define combinations
292 //SDL Image
293 {$IFDEF GLB_SDL_IMAGE}
294   {$IFNDEF GLB_SDL}
295     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
296     {$DEFINE GLB_SDL}
297   {$ENDIF}
298   {$IFDEF GLB_PNGIMAGE}
299     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
300     {$undef GLB_PNGIMAGE}
301   {$ENDIF}
302   {$IFDEF GLB_DELPHI_JPEG}
303     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
304     {$undef GLB_DELPHI_JPEG}
305   {$ENDIF}
306   {$IFDEF GLB_LIB_PNG}
307     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
308     {$undef GLB_LIB_PNG}
309   {$ENDIF}
310   {$IFDEF GLB_LIB_JPEG}
311     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
312     {$undef GLB_LIB_JPEG}
313   {$ENDIF}
314
315   {$DEFINE GLB_SUPPORT_PNG_READ}
316   {$DEFINE GLB_SUPPORT_JPEG_READ}
317 {$ENDIF}
318
319 // PNG Image
320 {$IFDEF GLB_PNGIMAGE}
321   {$IFDEF GLB_LIB_PNG}
322     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
323     {$undef GLB_LIB_PNG}
324   {$ENDIF}
325
326   {$DEFINE GLB_SUPPORT_PNG_READ}
327   {$DEFINE GLB_SUPPORT_PNG_WRITE}
328 {$ENDIF}
329
330 // libPNG
331 {$IFDEF GLB_LIB_PNG}
332   {$DEFINE GLB_SUPPORT_PNG_READ}
333   {$DEFINE GLB_SUPPORT_PNG_WRITE}
334 {$ENDIF}
335
336 // JPEG Image
337 {$IFDEF GLB_DELPHI_JPEG}
338   {$IFDEF GLB_LIB_JPEG}
339     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
340     {$undef GLB_LIB_JPEG}
341   {$ENDIF}
342
343   {$DEFINE GLB_SUPPORT_JPEG_READ}
344   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
345 {$ENDIF}
346
347 // libJPEG
348 {$IFDEF GLB_LIB_JPEG}
349   {$DEFINE GLB_SUPPORT_JPEG_READ}
350   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
351 {$ENDIF}
352
353 // native OpenGL
354 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
355   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
356 {$ENDIF}
357
358 // general options
359 {$EXTENDEDSYNTAX ON}
360 {$LONGSTRINGS ON}
361 {$ALIGN ON}
362 {$IFNDEF FPC}
363   {$OPTIMIZATION ON}
364 {$ENDIF}
365
366 interface
367
368 uses
369   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                   {$ENDIF}
370   {$IF DEFINED(GLB_WIN) AND
371        DEFINED(GLB_NATIVE_OGL)} windows,                 {$IFEND}
372
373   {$IFDEF GLB_SDL}              SDL,                         {$ENDIF}
374   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,           {$ENDIF}
375
376   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                   {$ENDIF}
377
378   {$IFDEF GLB_PNGIMAGE}         pngimage,                    {$ENDIF}
379   {$IFDEF GLB_LIB_PNG}          libPNG,                      {$ENDIF}
380
381   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                        {$ENDIF}
382   {$IFDEF GLB_LIB_JPEG}         libJPEG,                     {$ENDIF}
383
384   Classes, SysUtils;
385
386 {$IFNDEF GLB_DELPHI}
387 type
388   HGLRC = Cardinal;
389   DWORD = Cardinal;
390   PDWORD = ^DWORD;
391
392   TRGBQuad = packed record
393     rgbBlue: Byte;
394     rgbGreen: Byte;
395     rgbRed: Byte;
396     rgbReserved: Byte;
397   end;
398 {$ENDIF}
399
400 {$IFDEF GLB_NATIVE_OGL}
401 const
402   GL_TRUE   = 1;
403   GL_FALSE  = 0;
404
405   GL_VERSION    = $1F02;
406   GL_EXTENSIONS = $1F03;
407
408   GL_TEXTURE_1D         = $0DE0;
409   GL_TEXTURE_2D         = $0DE1;
410   GL_TEXTURE_RECTANGLE  = $84F5;
411
412   GL_TEXTURE_WIDTH            = $1000;
413   GL_TEXTURE_HEIGHT           = $1001;
414   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
415
416   GL_ALPHA    = $1906;
417   GL_ALPHA4   = $803B;
418   GL_ALPHA8   = $803C;
419   GL_ALPHA12  = $803D;
420   GL_ALPHA16  = $803E;
421
422   GL_LUMINANCE    = $1909;
423   GL_LUMINANCE4   = $803F;
424   GL_LUMINANCE8   = $8040;
425   GL_LUMINANCE12  = $8041;
426   GL_LUMINANCE16  = $8042;
427
428   GL_LUMINANCE_ALPHA      = $190A;
429   GL_LUMINANCE4_ALPHA4    = $8043;
430   GL_LUMINANCE6_ALPHA2    = $8044;
431   GL_LUMINANCE8_ALPHA8    = $8045;
432   GL_LUMINANCE12_ALPHA4   = $8046;
433   GL_LUMINANCE12_ALPHA12  = $8047;
434   GL_LUMINANCE16_ALPHA16  = $8048;
435
436   GL_RGB      = $1907;
437   GL_BGR      = $80E0;
438   GL_R3_G3_B2 = $2A10;
439   GL_RGB4     = $804F;
440   GL_RGB5     = $8050;
441   GL_RGB565   = $8D62;
442   GL_RGB8     = $8051;
443   GL_RGB10    = $8052;
444   GL_RGB12    = $8053;
445   GL_RGB16    = $8054;
446
447   GL_RGBA     = $1908;
448   GL_BGRA     = $80E1;
449   GL_RGBA2    = $8055;
450   GL_RGBA4    = $8056;
451   GL_RGB5_A1  = $8057;
452   GL_RGBA8    = $8058;
453   GL_RGB10_A2 = $8059;
454   GL_RGBA12   = $805A;
455   GL_RGBA16   = $805B;
456
457   GL_DEPTH_COMPONENT    = $1902;
458   GL_DEPTH_COMPONENT16  = $81A5;
459   GL_DEPTH_COMPONENT24  = $81A6;
460   GL_DEPTH_COMPONENT32  = $81A7;
461
462   GL_COMPRESSED_RGB                 = $84ED;
463   GL_COMPRESSED_RGBA                = $84EE;
464   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
465   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
466   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
467   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
468
469   GL_UNSIGNED_BYTE            = $1401;
470   GL_UNSIGNED_BYTE_3_3_2      = $8032;
471   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
472
473   GL_UNSIGNED_SHORT             = $1403;
474   GL_UNSIGNED_SHORT_5_6_5       = $8363;
475   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
476   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
477   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
478   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
479   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
480
481   GL_UNSIGNED_INT                 = $1405;
482   GL_UNSIGNED_INT_8_8_8_8         = $8035;
483   GL_UNSIGNED_INT_10_10_10_2      = $8036;
484   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
485   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
486
487   { Texture Filter }
488   GL_TEXTURE_MAG_FILTER     = $2800;
489   GL_TEXTURE_MIN_FILTER     = $2801;
490   GL_NEAREST                = $2600;
491   GL_NEAREST_MIPMAP_NEAREST = $2700;
492   GL_NEAREST_MIPMAP_LINEAR  = $2702;
493   GL_LINEAR                 = $2601;
494   GL_LINEAR_MIPMAP_NEAREST  = $2701;
495   GL_LINEAR_MIPMAP_LINEAR   = $2703;
496
497   { Texture Wrap }
498   GL_TEXTURE_WRAP_S   = $2802;
499   GL_TEXTURE_WRAP_T   = $2803;
500   GL_TEXTURE_WRAP_R   = $8072;
501   GL_CLAMP            = $2900;
502   GL_REPEAT           = $2901;
503   GL_CLAMP_TO_EDGE    = $812F;
504   GL_CLAMP_TO_BORDER  = $812D;
505   GL_MIRRORED_REPEAT  = $8370;
506
507   { Other }
508   GL_GENERATE_MIPMAP      = $8191;
509   GL_TEXTURE_BORDER_COLOR = $1004;
510   GL_MAX_TEXTURE_SIZE     = $0D33;
511   GL_PACK_ALIGNMENT       = $0D05;
512   GL_UNPACK_ALIGNMENT     = $0CF5;
513
514   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
515   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
516
517 {$ifdef LINUX}
518   libglu    = 'libGLU.so.1';
519   libopengl = 'libGL.so.1';
520 {$else}
521   libglu    = 'glu32.dll';
522   libopengl = 'opengl32.dll';
523 {$endif}
524
525 type
526   GLboolean = BYTEBOOL;
527   GLint     = Integer;
528   GLsizei   = Integer;
529   GLuint    = Cardinal;
530   GLfloat   = Single;
531   GLenum    = Cardinal;
532
533   PGLvoid    = Pointer;
534   PGLboolean = ^GLboolean;
535   PGLint     = ^GLint;
536   PGLuint    = ^GLuint;
537   PGLfloat   = ^GLfloat;
538
539   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
540   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
541   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
542
543 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
544   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
545   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
546
547   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
548   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
549
550   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
551   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
552   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
553   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
554   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
555   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
556
557   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
558   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
559   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
560
561   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
562   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
563   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
564
565   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
566   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
567   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
568
569   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
570   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
571
572   {$IFDEF GLB_LINUX}
573   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
574   {$ELSE}
575   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
576   {$ENDIF}
577
578 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
579   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
580   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
581
582   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
583   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
584
585   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
586   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
587   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
588   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
589   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
590   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
591
592   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
593   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
594   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
595
596   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
597   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
598   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
599
600   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
601   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
602   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
603
604   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
605   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
606 {$ENDIF}
607
608 var
609   GL_VERSION_1_2,
610   GL_VERSION_1_3,
611   GL_VERSION_1_4,
612   GL_VERSION_2_0,
613
614   GL_SGIS_generate_mipmap,
615
616   GL_ARB_texture_border_clamp,
617   GL_ARB_texture_mirrored_repeat,
618   GL_ARB_texture_rectangle,
619   GL_ARB_texture_non_power_of_two,
620
621   GL_IBM_texture_mirrored_repeat,
622
623   GL_NV_texture_rectangle,
624
625   GL_EXT_texture_edge_clamp,
626   GL_EXT_texture_rectangle,
627   GL_EXT_texture_filter_anisotropic: Boolean;
628
629   glCompressedTexImage1D: TglCompressedTexImage1D;
630   glCompressedTexImage2D: TglCompressedTexImage2D;
631   glGetCompressedTexImage: TglGetCompressedTexImage;
632
633 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
634   glEnable: TglEnable;
635   glDisable: TglDisable;
636
637   glGetString: TglGetString;
638   glGetIntegerv: TglGetIntegerv;
639
640   glTexParameteri: TglTexParameteri;
641   glTexParameterfv: TglTexParameterfv;
642   glGetTexParameteriv: TglGetTexParameteriv;
643   glGetTexParameterfv: TglGetTexParameterfv;
644   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
645   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
646
647   glGenTextures: TglGenTextures;
648   glBindTexture: TglBindTexture;
649   glDeleteTextures: TglDeleteTextures;
650
651   glAreTexturesResident: TglAreTexturesResident;
652   glReadPixels: TglReadPixels;
653   glPixelStorei: TglPixelStorei;
654
655   glTexImage1D: TglTexImage1D;
656   glTexImage2D: TglTexImage2D;
657   glGetTexImage: TglGetTexImage;
658
659   gluBuild1DMipmaps: TgluBuild1DMipmaps;
660   gluBuild2DMipmaps: TgluBuild2DMipmaps;
661
662   {$IF DEFINED(GLB_WIN)}
663   wglGetProcAddress: TwglGetProcAddress;
664   {$ELSEIF DEFINED(GLB_LINUX)}
665   glXGetProcAddress: TglXGetProcAddress;
666   glXGetProcAddressARB: TglXGetProcAddressARB;
667   {$ENDIF}
668 {$ENDIF}
669
670 (*
671 {$IFDEF GLB_DELPHI}
672 var
673   gLastContext: HGLRC;
674 {$ENDIF}
675 *)
676
677 {$ENDIF}
678
679 type
680 ////////////////////////////////////////////////////////////////////////////////////////////////////
681   EglBitmapException               = class(Exception);
682   EglBitmapSizeToLargeException    = class(EglBitmapException);
683   EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
684   EglBitmapUnsupportedFormat       = class(EglBitmapException);
685
686 ////////////////////////////////////////////////////////////////////////////////////////////////////
687   TglBitmapFormat = (
688     tfEmpty = 0, //must be smallest value!
689
690     tfAlpha4,
691     tfAlpha8,
692     tfAlpha12,
693     tfAlpha16,
694
695     tfLuminance4,
696     tfLuminance8,
697     tfLuminance12,
698     tfLuminance16,
699
700     tfLuminance4Alpha4,
701     tfLuminance6Alpha2,
702     tfLuminance8Alpha8,
703     tfLuminance12Alpha4,
704     tfLuminance12Alpha12,
705     tfLuminance16Alpha16,
706
707     tfR3G3B2,
708     tfRGB4,
709     tfR5G6B5,
710     tfRGB5,
711     tfRGB8,
712     tfRGB10,
713     tfRGB12,
714     tfRGB16,
715
716     tfRGBA2,
717     tfRGBA4,
718     tfRGB5A1,
719     tfRGBA8,
720     tfRGB10A2,
721     tfRGBA12,
722     tfRGBA16,
723
724     tfBGR4,
725     tfB5G6R5,
726     tfBGR5,
727     tfBGR8,
728     tfBGR10,
729     tfBGR12,
730     tfBGR16,
731
732     tfBGRA2,
733     tfBGRA4,
734     tfBGR5A1,
735     tfBGRA8,
736     tfBGR10A2,
737     tfBGRA12,
738     tfBGRA16,
739
740     tfDepth16,
741     tfDepth24,
742     tfDepth32,
743
744     tfS3tcDtx1RGBA,
745     tfS3tcDtx3RGBA,
746     tfS3tcDtx5RGBA
747   );
748
749   TglBitmapFileType = (
750      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
751      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
752      ftDDS,
753      ftTGA,
754      ftBMP);
755    TglBitmapFileTypes = set of TglBitmapFileType;
756
757    TglBitmapMipMap = (
758      mmNone,
759      mmMipmap,
760      mmMipmapGlu);
761
762    TglBitmapNormalMapFunc = (
763      nm4Samples,
764      nmSobel,
765      nm3x3,
766      nm5x5);
767
768 ////////////////////////////////////////////////////////////////////////////////////////////////////
769   TglBitmapColorRec = packed record
770   case Integer of
771     0: (r, g, b, a: Cardinal);
772     1: (arr: array[0..3] of Cardinal);
773   end;
774
775   TglBitmapPixelData = packed record
776     Data, Range: TglBitmapColorRec;
777     Format: TglBitmapFormat;
778   end;
779   PglBitmapPixelData = ^TglBitmapPixelData;
780
781 ////////////////////////////////////////////////////////////////////////////////////////////////////
782   TglBitmapPixelPositionFields = set of (ffX, ffY);
783   TglBitmapPixelPosition = record
784     Fields : TglBitmapPixelPositionFields;
785     X : Word;
786     Y : Word;
787   end;
788
789 ////////////////////////////////////////////////////////////////////////////////////////////////////
790   TglBitmap = class;
791   TglBitmapFunctionRec = record
792     Sender:   TglBitmap;
793     Size:     TglBitmapPixelPosition;
794     Position: TglBitmapPixelPosition;
795     Source:   TglBitmapPixelData;
796     Dest:     TglBitmapPixelData;
797     Args:     Pointer;
798   end;
799   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
800
801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
802   TglBitmap = class
803   protected
804     fID: GLuint;
805     fTarget: GLuint;
806     fAnisotropic: Integer;
807     fDeleteTextureOnFree: Boolean;
808     fFreeDataAfterGenTexture: Boolean;
809     fData: PByte;
810     fIsResident: Boolean;
811     fBorderColor: array[0..3] of Single;
812
813     fDimension: TglBitmapPixelPosition;
814     fMipMap: TglBitmapMipMap;
815     fFormat: TglBitmapFormat;
816
817     // Mapping
818     fPixelSize: Integer;
819     fRowSize: Integer;
820
821     // Filtering
822     fFilterMin: Cardinal;
823     fFilterMag: Cardinal;
824
825     // TexturWarp
826     fWrapS: Cardinal;
827     fWrapT: Cardinal;
828     fWrapR: Cardinal;
829
830     // CustomData
831     fFilename: String;
832     fCustomName: String;
833     fCustomNameW: WideString;
834     fCustomData: Pointer;
835
836     //Getter
837     function GetWidth:  Integer; virtual;
838     function GetHeight: Integer; virtual;
839
840     function GetFileWidth:  Integer; virtual;
841     function GetFileHeight: Integer; virtual;
842
843     //Setter
844     procedure SetCustomData(const aValue: Pointer);
845     procedure SetCustomName(const aValue: String);
846     procedure SetCustomNameW(const aValue: WideString);
847     procedure SetDeleteTextureOnFree(const aValue: Boolean);
848     procedure SetFormat(const aValue: TglBitmapFormat);
849     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
850     procedure SetID(const aValue: Cardinal);
851     procedure SetMipMap(const aValue: TglBitmapMipMap);
852     procedure SetTarget(const aValue: Cardinal);
853     procedure SetAnisotropic(const aValue: Integer);
854
855     procedure CreateID;
856     procedure SetupParameters(out aBuildWithGlu: Boolean);
857     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
858       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
859     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
860
861     function FlipHorz: Boolean; virtual;
862     function FlipVert: Boolean; virtual;
863
864     property Width:  Integer read GetWidth;
865     property Height: Integer read GetHeight;
866
867     property FileWidth:  Integer read GetFileWidth;
868     property FileHeight: Integer read GetFileHeight;
869   public
870     //Properties
871     property ID:           Cardinal        read fID          write SetID;
872     property Target:       Cardinal        read fTarget      write SetTarget;
873     property Format:       TglBitmapFormat read fFormat      write SetFormat;
874     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
875     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
876
877     property Filename:    String     read fFilename;
878     property CustomName:  String     read fCustomName  write SetCustomName;
879     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
880     property CustomData:  Pointer    read fCustomData  write SetCustomData;
881
882     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
883     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
884
885     property Dimension:  TglBitmapPixelPosition  read fDimension;
886     property Data:       PByte                   read fData;
887     property IsResident: Boolean                 read fIsResident;
888
889     procedure AfterConstruction; override;
890     procedure BeforeDestruction; override;
891
892     //Load
893     procedure LoadFromFile(const aFilename: String);
894     procedure LoadFromStream(const aStream: TStream); virtual;
895     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
896       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
897     {$IFDEF GLB_DELPHI}
898     procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
899     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
900     {$ENDIF}
901
902     //Save
903     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
904     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
905
906     //Convert
907     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
908     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
909       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
910   public
911     //Alpha & Co
912     {$IFDEF GLB_SDL}
913     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
914     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
915     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
916     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
917       const aArgs: Pointer = nil): Boolean;
918     {$ENDIF}
919
920     {$IFDEF GLB_DELPHI}
921     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
922     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
923     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
924     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
925       const aArgs: Pointer = nil): Boolean;
926     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
927       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
928     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
929       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
930     {$ENDIF}
931
932     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
933     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
934     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
935     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
936
937     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
938     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
939     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
940
941     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
942     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
943     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
944
945     function RemoveAlpha: Boolean; virtual;
946   public
947     //Common
948     function Clone: TglBitmap;
949     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
950     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
951     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
952     procedure FreeData;
953
954     //ColorFill
955     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
956     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
957     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
958
959     //TexParameters
960     procedure SetFilter(const aMin, aMag: Cardinal);
961     procedure SetWrap(
962       const S: Cardinal = GL_CLAMP_TO_EDGE;
963       const T: Cardinal = GL_CLAMP_TO_EDGE;
964       const R: Cardinal = GL_CLAMP_TO_EDGE);
965
966     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
967     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
968
969     //Constructors
970     constructor Create; overload;
971     constructor Create(const aFileName: String); overload;
972     constructor Create(const aStream: TStream); overload;
973     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
974     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
975     {$IFDEF GLB_DELPHI}
976     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
977     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
978     {$ENDIF}
979   private
980     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
981     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
982
983     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
984     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
985
986     function LoadBMP(const aStream: TStream): Boolean; virtual;
987     procedure SaveBMP(const aStream: TStream); virtual;
988
989     function LoadTGA(const aStream: TStream): Boolean; virtual;
990     procedure SaveTGA(const aStream: TStream); virtual;
991
992     function LoadDDS(const aStream: TStream): Boolean; virtual;
993     procedure SaveDDS(const aStream: TStream); virtual;
994   end;
995
996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
997   TglBitmap2D = class(TglBitmap)
998   protected
999     // Bildeinstellungen
1000     fLines: array of PByte;
1001
1002     (* TODO
1003     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
1004     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1005     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1006     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1007     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1008     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
1009     *)
1010
1011     function GetScanline(const aIndex: Integer): Pointer;
1012     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1013       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1014     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1015   public
1016     property Width;
1017     property Height;
1018     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1019
1020     procedure AfterConstruction; override;
1021
1022     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1023     procedure GetDataFromTexture;
1024     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1025
1026     function FlipHorz: Boolean; override;
1027     function FlipVert: Boolean; override;
1028
1029     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1030       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1031   end;
1032
1033 (* TODO
1034   TglBitmapCubeMap = class(TglBitmap2D)
1035   protected
1036     fGenMode: Integer;
1037
1038     // Hide GenTexture
1039     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1040   public
1041     procedure AfterConstruction; override;
1042
1043     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1044
1045     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1046     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1047   end;
1048
1049
1050   TglBitmapNormalMap = class(TglBitmapCubeMap)
1051   public
1052     procedure AfterConstruction; override;
1053
1054     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1055   end;
1056
1057
1058   TglBitmap1D = class(TglBitmap)
1059   protected
1060     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1061
1062     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1063     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1064   public
1065     // propertys
1066     property Width;
1067
1068     procedure AfterConstruction; override;
1069
1070     // Other
1071     function FlipHorz: Boolean; override;
1072
1073     // Generation
1074     procedure GenTexture(TestTextureSize: Boolean = true); override;
1075   end;
1076 *)
1077
1078 const
1079   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1080
1081 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1082 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1083 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1084 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1085 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1086 procedure glBitmapSetDefaultWrap(
1087   const S: Cardinal = GL_CLAMP_TO_EDGE;
1088   const T: Cardinal = GL_CLAMP_TO_EDGE;
1089   const R: Cardinal = GL_CLAMP_TO_EDGE);
1090
1091 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1092 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1093 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1094 function glBitmapGetDefaultFormat: TglBitmapFormat;
1095 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1096 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1097
1098 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1099 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1100 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1101
1102 var
1103   glBitmapDefaultDeleteTextureOnFree: Boolean;
1104   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1105   glBitmapDefaultFormat: TglBitmapFormat;
1106   glBitmapDefaultMipmap: TglBitmapMipMap;
1107   glBitmapDefaultFilterMin: Cardinal;
1108   glBitmapDefaultFilterMag: Cardinal;
1109   glBitmapDefaultWrapS: Cardinal;
1110   glBitmapDefaultWrapT: Cardinal;
1111   glBitmapDefaultWrapR: Cardinal;
1112
1113 {$IFDEF GLB_DELPHI}
1114 function CreateGrayPalette: HPALETTE;
1115 {$ENDIF}
1116
1117 implementation
1118
1119
1120     (* TODO
1121     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1122     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1123     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1124     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1125     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1126     *)
1127
1128 uses
1129   Math, syncobjs;
1130
1131 type
1132 ////////////////////////////////////////////////////////////////////////////////////////////////////
1133   TShiftRec = packed record
1134   case Integer of
1135     0: (r, g, b, a: Byte);
1136     1: (arr: array[0..3] of Byte);
1137   end;
1138
1139   TFormatDescriptor = class(TObject)
1140   private
1141     function GetRedMask: QWord;
1142     function GetGreenMask: QWord;
1143     function GetBlueMask: QWord;
1144     function GetAlphaMask: QWord;
1145   protected
1146     fFormat: TglBitmapFormat;
1147     fWithAlpha: TglBitmapFormat;
1148     fWithoutAlpha: TglBitmapFormat;
1149     fRGBInverted: TglBitmapFormat;
1150     fUncompressed: TglBitmapFormat;
1151     fPixelSize: Single;
1152     fIsCompressed: Boolean;
1153
1154     fRange: TglBitmapColorRec;
1155     fShift: TShiftRec;
1156
1157     fglFormat:         Cardinal;
1158     fglInternalFormat: Cardinal;
1159     fglDataFormat:     Cardinal;
1160
1161     function GetComponents: Integer; virtual;
1162   public
1163     property Format:       TglBitmapFormat read fFormat;
1164     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1165     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1166     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1167     property Components:   Integer         read GetComponents;
1168     property PixelSize:    Single          read fPixelSize;
1169     property IsCompressed: Boolean         read fIsCompressed;
1170
1171     property glFormat:         Cardinal read fglFormat;
1172     property glInternalFormat: Cardinal read fglInternalFormat;
1173     property glDataFormat:     Cardinal read fglDataFormat;
1174
1175     property Range: TglBitmapColorRec read fRange;
1176     property Shift: TShiftRec         read fShift;
1177
1178     property RedMask:   QWord read GetRedMask;
1179     property GreenMask: QWord read GetGreenMask;
1180     property BlueMask:  QWord read GetBlueMask;
1181     property AlphaMask: QWord read GetAlphaMask;
1182
1183     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1184     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1185
1186     function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1187     function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1188
1189     function CreateMappingData: Pointer; virtual;
1190     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1191
1192     function IsEmpty:  Boolean; virtual;
1193     function HasAlpha: Boolean; virtual;
1194     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1195
1196     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1197
1198     constructor Create; virtual;
1199   public
1200     class procedure Init;
1201     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1202     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1203     class procedure Clear;
1204     class procedure Finalize;
1205   end;
1206   TFormatDescriptorClass = class of TFormatDescriptor;
1207
1208   TfdEmpty = class(TFormatDescriptor);
1209
1210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1211   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1212     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1213     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1214     constructor Create; override;
1215   end;
1216
1217   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1218     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1219     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1220     constructor Create; override;
1221   end;
1222
1223   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1224     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1225     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1226     constructor Create; override;
1227   end;
1228
1229   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1230     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1231     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1232     constructor Create; override;
1233   end;
1234
1235   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1236     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1237     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1238     constructor Create; override;
1239   end;
1240
1241   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1242     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1243     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1244     constructor Create; override;
1245   end;
1246
1247   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1248     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1249     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1250     constructor Create; override;
1251   end;
1252
1253   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1254     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1255     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1256     constructor Create; override;
1257   end;
1258
1259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1260   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1261     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1262     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1263     constructor Create; override;
1264   end;
1265
1266   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1267     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1268     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1269     constructor Create; override;
1270   end;
1271
1272   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1273     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1274     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1275     constructor Create; override;
1276   end;
1277
1278   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1279     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1280     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1281     constructor Create; override;
1282   end;
1283
1284   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1285     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1286     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1287     constructor Create; override;
1288   end;
1289
1290   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1291     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1292     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1293     constructor Create; override;
1294   end;
1295
1296   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1297     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1298     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1299     constructor Create; override;
1300   end;
1301
1302   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1303     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1304     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1305     constructor Create; override;
1306   end;
1307
1308   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1309     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1310     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1311     constructor Create; override;
1312   end;
1313
1314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1315   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1316     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1317     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1318     constructor Create; override;
1319   end;
1320
1321   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1322     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1323     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1324     constructor Create; override;
1325   end;
1326
1327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1328   TfdAlpha4 = class(TfdAlpha_UB1)
1329     constructor Create; override;
1330   end;
1331
1332   TfdAlpha8 = class(TfdAlpha_UB1)
1333     constructor Create; override;
1334   end;
1335
1336   TfdAlpha12 = class(TfdAlpha_US1)
1337     constructor Create; override;
1338   end;
1339
1340   TfdAlpha16 = class(TfdAlpha_US1)
1341     constructor Create; override;
1342   end;
1343
1344   TfdLuminance4 = class(TfdLuminance_UB1)
1345     constructor Create; override;
1346   end;
1347
1348   TfdLuminance8 = class(TfdLuminance_UB1)
1349     constructor Create; override;
1350   end;
1351
1352   TfdLuminance12 = class(TfdLuminance_US1)
1353     constructor Create; override;
1354   end;
1355
1356   TfdLuminance16 = class(TfdLuminance_US1)
1357     constructor Create; override;
1358   end;
1359
1360   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1361     constructor Create; override;
1362   end;
1363
1364   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1365     constructor Create; override;
1366   end;
1367
1368   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1369     constructor Create; override;
1370   end;
1371
1372   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1373     constructor Create; override;
1374   end;
1375
1376   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1377     constructor Create; override;
1378   end;
1379
1380   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1381     constructor Create; override;
1382   end;
1383
1384   TfdR3G3B2 = class(TfdUniversal_UB1)
1385     constructor Create; override;
1386   end;
1387
1388   TfdRGB4 = class(TfdUniversal_US1)
1389     constructor Create; override;
1390   end;
1391
1392   TfdR5G6B5 = class(TfdUniversal_US1)
1393     constructor Create; override;
1394   end;
1395
1396   TfdRGB5 = class(TfdUniversal_US1)
1397     constructor Create; override;
1398   end;
1399
1400   TfdRGB8 = class(TfdRGB_UB3)
1401     constructor Create; override;
1402   end;
1403
1404   TfdRGB10 = class(TfdUniversal_UI1)
1405     constructor Create; override;
1406   end;
1407
1408   TfdRGB12 = class(TfdRGB_US3)
1409     constructor Create; override;
1410   end;
1411
1412   TfdRGB16 = class(TfdRGB_US3)
1413     constructor Create; override;
1414   end;
1415
1416   TfdRGBA2 = class(TfdRGBA_UB4)
1417     constructor Create; override;
1418   end;
1419
1420   TfdRGBA4 = class(TfdUniversal_US1)
1421     constructor Create; override;
1422   end;
1423
1424   TfdRGB5A1 = class(TfdUniversal_US1)
1425     constructor Create; override;
1426   end;
1427
1428   TfdRGBA8 = class(TfdRGBA_UB4)
1429     constructor Create; override;
1430   end;
1431
1432   TfdRGB10A2 = class(TfdUniversal_UI1)
1433     constructor Create; override;
1434   end;
1435
1436   TfdRGBA12 = class(TfdRGBA_US4)
1437     constructor Create; override;
1438   end;
1439
1440   TfdRGBA16 = class(TfdRGBA_US4)
1441     constructor Create; override;
1442   end;
1443
1444   TfdBGR4 = class(TfdUniversal_US1)
1445     constructor Create; override;
1446   end;
1447
1448   TfdB5G6R5 = class(TfdUniversal_US1)
1449     constructor Create; override;
1450   end;
1451
1452   TfdBGR5 = class(TfdUniversal_US1)
1453     constructor Create; override;
1454   end;
1455
1456   TfdBGR8 = class(TfdBGR_UB3)
1457     constructor Create; override;
1458   end;
1459
1460   TfdBGR10 = class(TfdUniversal_UI1)
1461     constructor Create; override;
1462   end;
1463
1464   TfdBGR12 = class(TfdBGR_US3)
1465     constructor Create; override;
1466   end;
1467
1468   TfdBGR16 = class(TfdBGR_US3)
1469     constructor Create; override;
1470   end;
1471
1472   TfdBGRA2 = class(TfdBGRA_UB4)
1473     constructor Create; override;
1474   end;
1475
1476   TfdBGRA4 = class(TfdUniversal_US1)
1477     constructor Create; override;
1478   end;
1479
1480   TfdBGR5A1 = class(TfdUniversal_US1)
1481     constructor Create; override;
1482   end;
1483
1484   TfdBGRA8 = class(TfdBGRA_UB4)
1485     constructor Create; override;
1486   end;
1487
1488   TfdBGR10A2 = class(TfdUniversal_UI1)
1489     constructor Create; override;
1490   end;
1491
1492   TfdBGRA12 = class(TfdBGRA_US4)
1493     constructor Create; override;
1494   end;
1495
1496   TfdBGRA16 = class(TfdBGRA_US4)
1497     constructor Create; override;
1498   end;
1499
1500   TfdDepth16 = class(TfdDepth_US1)
1501     constructor Create; override;
1502   end;
1503
1504   TfdDepth24 = class(TfdDepth_UI1)
1505     constructor Create; override;
1506   end;
1507
1508   TfdDepth32 = class(TfdDepth_UI1)
1509     constructor Create; override;
1510   end;
1511
1512   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1513     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1514     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1515     constructor Create; override;
1516   end;
1517
1518   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1519     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1520     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1521     constructor Create; override;
1522   end;
1523
1524   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1525     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1526     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1527     constructor Create; override;
1528   end;
1529
1530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1531   TbmpBitfieldFormat = class(TFormatDescriptor)
1532   private
1533     procedure SetRedMask  (const aValue: QWord);
1534     procedure SetGreenMask(const aValue: QWord);
1535     procedure SetBlueMask (const aValue: QWord);
1536     procedure SetAlphaMask(const aValue: QWord);
1537
1538     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1539   public
1540     property RedMask:   QWord read GetRedMask   write SetRedMask;
1541     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1542     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1543     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1544
1545     property PixelSize: Single read fPixelSize write fPixelSize;
1546
1547     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1548     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1549   end;
1550
1551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1552   TbmpColorTableEnty = packed record
1553     b, g, r, a: Byte;
1554   end;
1555   TbmpColorTable = array of TbmpColorTableEnty;
1556   TbmpColorTableFormat = class(TFormatDescriptor)
1557   private
1558     fColorTable: TbmpColorTable;
1559   public
1560     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1561     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1562     property Range:      TglBitmapColorRec read fRange      write fRange;
1563     property Shift:      TShiftRec         read fShift      write fShift;
1564     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1565
1566     procedure CreateColorTable;
1567
1568     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1569     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1570     destructor Destroy; override;
1571   end;
1572
1573 const
1574   LUMINANCE_WEIGHT_R = 0.30;
1575   LUMINANCE_WEIGHT_G = 0.59;
1576   LUMINANCE_WEIGHT_B = 0.11;
1577
1578   ALPHA_WEIGHT_R = 0.30;
1579   ALPHA_WEIGHT_G = 0.59;
1580   ALPHA_WEIGHT_B = 0.11;
1581
1582   DEPTH_WEIGHT_R = 0.333333333;
1583   DEPTH_WEIGHT_G = 0.333333333;
1584   DEPTH_WEIGHT_B = 0.333333333;
1585
1586   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1587
1588   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1589     TfdEmpty,
1590
1591     TfdAlpha4,
1592     TfdAlpha8,
1593     TfdAlpha12,
1594     TfdAlpha16,
1595
1596     TfdLuminance4,
1597     TfdLuminance8,
1598     TfdLuminance12,
1599     TfdLuminance16,
1600
1601     TfdLuminance4Alpha4,
1602     TfdLuminance6Alpha2,
1603     TfdLuminance8Alpha8,
1604     TfdLuminance12Alpha4,
1605     TfdLuminance12Alpha12,
1606     TfdLuminance16Alpha16,
1607
1608     TfdR3G3B2,
1609     TfdRGB4,
1610     TfdR5G6B5,
1611     TfdRGB5,
1612     TfdRGB8,
1613     TfdRGB10,
1614     TfdRGB12,
1615     TfdRGB16,
1616
1617     TfdRGBA2,
1618     TfdRGBA4,
1619     TfdRGB5A1,
1620     TfdRGBA8,
1621     TfdRGB10A2,
1622     TfdRGBA12,
1623     TfdRGBA16,
1624
1625     TfdBGR4,
1626     TfdB5G6R5,
1627     TfdBGR5,
1628     TfdBGR8,
1629     TfdBGR10,
1630     TfdBGR12,
1631     TfdBGR16,
1632
1633     TfdBGRA2,
1634     TfdBGRA4,
1635     TfdBGR5A1,
1636     TfdBGRA8,
1637     TfdBGR10A2,
1638     TfdBGRA12,
1639     TfdBGRA16,
1640
1641     TfdDepth16,
1642     TfdDepth24,
1643     TfdDepth32,
1644
1645     TfdS3tcDtx1RGBA,
1646     TfdS3tcDtx3RGBA,
1647     TfdS3tcDtx5RGBA
1648   );
1649
1650 var
1651   FormatDescriptorCS: TCriticalSection;
1652   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1653
1654 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1655 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1656 begin
1657   result.Fields := [];
1658
1659   if X >= 0 then
1660     result.Fields := result.Fields + [ffX];
1661   if Y >= 0 then
1662     result.Fields := result.Fields + [ffY];
1663
1664   result.X := Max(0, X);
1665   result.Y := Max(0, Y);
1666 end;
1667
1668 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1669 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1670 begin
1671   result.r := r;
1672   result.g := g;
1673   result.b := b;
1674   result.a := a;
1675 end;
1676
1677 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1678 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1679 var
1680   i: Integer;
1681 begin
1682   result := false;
1683   for i := 0 to high(r1.arr) do
1684     if (r1.arr[i] <> r2.arr[i]) then
1685       exit;
1686   result := true;
1687 end;
1688
1689 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1690 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1691 begin
1692   result.r := r;
1693   result.g := g;
1694   result.b := b;
1695   result.a := a;
1696 end;
1697
1698 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1699 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1700 begin
1701   result := [];
1702
1703   if (aFormat in [
1704         //4 bbp
1705         tfLuminance4,
1706
1707         //8bpp
1708         tfR3G3B2, tfLuminance8,
1709
1710         //16bpp
1711         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1712         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1713
1714         //24bpp
1715         tfBGR8, tfRGB8,
1716
1717         //32bpp
1718         tfRGB10, tfRGB10A2, tfRGBA8,
1719         tfBGR10, tfBGR10A2, tfBGRA8]) then
1720     result := result + [ftBMP];
1721
1722   if (aFormat in [
1723         //8 bpp
1724         tfLuminance8, tfAlpha8,
1725
1726         //16 bpp
1727         tfLuminance16, tfLuminance8Alpha8,
1728         tfRGB5, tfRGB5A1, tfRGBA4,
1729         tfBGR5, tfBGR5A1, tfBGRA4,
1730
1731         //24 bpp
1732         tfRGB8, tfBGR8,
1733
1734         //32 bpp
1735         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1736     result := result + [ftTGA];
1737
1738   if (aFormat in [
1739         //8 bpp
1740         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1741         tfR3G3B2, tfRGBA2, tfBGRA2,
1742
1743         //16 bpp
1744         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1745         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1746         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1747
1748         //24 bpp
1749         tfRGB8, tfBGR8,
1750
1751         //32 bbp
1752         tfLuminance16Alpha16,
1753         tfRGBA8, tfRGB10A2,
1754         tfBGRA8, tfBGR10A2,
1755
1756         //compressed
1757         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1758     result := result + [ftDDS];
1759
1760   (* TODO
1761   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1762   if aFormat in [
1763     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1764     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1765     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1766     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1767     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1768     tfDepth16, tfDepth24, tfDepth32]
1769   then
1770     result := result + [ftPNG];
1771   {$ENDIF}
1772
1773   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1774   if Format in [
1775     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1776     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1777     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1778     tfDepth16, tfDepth24, tfDepth32]
1779   then
1780     result := result + [ftJPEG];
1781   {$ENDIF}
1782
1783   if aFormat in [
1784     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1785     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1786     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1787     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1788     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1789     tfDepth16, tfDepth24, tfDepth32]
1790   then
1791     result := result + [ftDDS, ftTGA, ftBMP];
1792   *)
1793 end;
1794
1795 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1796 function IsPowerOfTwo(aNumber: Integer): Boolean;
1797 begin
1798   while (aNumber and 1) = 0 do
1799     aNumber := aNumber shr 1;
1800   result := aNumber = 1;
1801 end;
1802
1803 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1804 function GetTopMostBit(aBitSet: QWord): Integer;
1805 begin
1806   result := 0;
1807   while aBitSet > 0 do begin
1808     inc(result);
1809     aBitSet := aBitSet shr 1;
1810   end;
1811 end;
1812
1813 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1814 function CountSetBits(aBitSet: QWord): Integer;
1815 begin
1816   result := 0;
1817   while aBitSet > 0 do begin
1818     if (aBitSet and 1) = 1 then
1819       inc(result);
1820     aBitSet := aBitSet shr 1;
1821   end;
1822 end;
1823
1824 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1826 begin
1827   result := Trunc(
1828     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1829     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1830     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1831 end;
1832
1833 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1834 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1835 begin
1836   result := Trunc(
1837     DEPTH_WEIGHT_R * aPixel.Data.r +
1838     DEPTH_WEIGHT_G * aPixel.Data.g +
1839     DEPTH_WEIGHT_B * aPixel.Data.b);
1840 end;
1841
1842 {$IFDEF GLB_NATIVE_OGL}
1843 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1844 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1845 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1846 var
1847   GL_LibHandle: Pointer = nil;
1848
1849 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1850 begin
1851   result :=  nil;
1852
1853   if not Assigned(aLibHandle) then
1854     aLibHandle := GL_LibHandle;
1855
1856 {$IF DEFINED(GLB_WIN)}
1857   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1858   if Assigned(result) then
1859     exit;
1860
1861   if Assigned(wglGetProcAddress) then
1862     result := wglGetProcAddress(aProcName);
1863 {$ELSEIF DEFINED(GLB_LINUX)}
1864   if Assigned(glXGetProcAddress) then begin
1865     result := glXGetProcAddress(aProcName);
1866     if Assigned(result) then
1867       exit;
1868   end;
1869
1870   if Assigned(glXGetProcAddressARB) then begin
1871     result := glXGetProcAddressARB(aProcName);
1872     if Assigned(result) then
1873       exit;
1874   end;
1875
1876   result := dlsym(aLibHandle, aProcName);
1877 {$ENDIF}
1878   if not Assigned(result) then
1879     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1880 end;
1881
1882 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1883 var
1884   GLU_LibHandle: Pointer = nil;
1885   OpenGLInitialized: Boolean;
1886   InitOpenGLCS: TCriticalSection;
1887
1888 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1889 procedure glbInitOpenGL;
1890
1891   ////////////////////////////////////////////////////////////////////////////////
1892   function glbLoadLibrary(const aName: PChar): Pointer;
1893   begin
1894     {$IF DEFINED(GLB_WIN)}
1895     result := {%H-}Pointer(LoadLibrary(aName));
1896     {$ELSEIF DEFINED(GLB_LINUX)}
1897     result := dlopen(Name, RTLD_LAZY);
1898     {$ELSE}
1899     result := nil;
1900     {$ENDIF}
1901   end;
1902
1903   ////////////////////////////////////////////////////////////////////////////////
1904   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1905   begin
1906     result := false;
1907     if not Assigned(aLibHandle) then
1908       exit;
1909
1910     {$IF DEFINED(GLB_WIN)}
1911     Result := FreeLibrary({%H-}HINST(aLibHandle));
1912     {$ELSEIF DEFINED(GLB_LINUX)}
1913     Result := dlclose(aLibHandle) = 0;
1914     {$ENDIF}
1915   end;
1916
1917 begin
1918   if Assigned(GL_LibHandle) then
1919     glbFreeLibrary(GL_LibHandle);
1920
1921   if Assigned(GLU_LibHandle) then
1922     glbFreeLibrary(GLU_LibHandle);
1923
1924   GL_LibHandle := glbLoadLibrary(libopengl);
1925   if not Assigned(GL_LibHandle) then
1926     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1927
1928   GLU_LibHandle := glbLoadLibrary(libglu);
1929   if not Assigned(GLU_LibHandle) then
1930     raise EglBitmapException.Create('unable to load library: ' + libglu);
1931
1932   try
1933   {$IF DEFINED(GLB_WIN)}
1934     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1935   {$ELSEIF DEFINED(GLB_LINUX)}
1936     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1937     glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
1938   {$ENDIF}
1939
1940     glEnable := glbGetProcAddress('glEnable');
1941     glDisable := glbGetProcAddress('glDisable');
1942     glGetString := glbGetProcAddress('glGetString');
1943     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1944     glTexParameteri := glbGetProcAddress('glTexParameteri');
1945     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1946     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1947     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1948     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1949     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1950     glGenTextures := glbGetProcAddress('glGenTextures');
1951     glBindTexture := glbGetProcAddress('glBindTexture');
1952     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1953     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1954     glReadPixels := glbGetProcAddress('glReadPixels');
1955     glPixelStorei := glbGetProcAddress('glPixelStorei');
1956     glTexImage1D := glbGetProcAddress('glTexImage1D');
1957     glTexImage2D := glbGetProcAddress('glTexImage2D');
1958     glGetTexImage := glbGetProcAddress('glGetTexImage');
1959
1960     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1961     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1962   finally
1963     glbFreeLibrary(GL_LibHandle);
1964     glbFreeLibrary(GLU_LibHandle);
1965   end;
1966 end;
1967 {$ENDIF}
1968
1969 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1970 procedure glbReadOpenGLExtensions;
1971 var
1972   {$IFDEF GLB_DELPHI}
1973   Context: HGLRC;
1974   {$ENDIF}
1975   Buffer: AnsiString;
1976   MajorVersion, MinorVersion: Integer;
1977
1978   ///////////////////////////////////////////////////////////////////////////////////////////
1979   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1980   var
1981     Separator: Integer;
1982   begin
1983     aMinor := 0;
1984     aMajor := 0;
1985
1986     Separator := Pos(AnsiString('.'), aBuffer);
1987     if (Separator > 1) and (Separator < Length(aBuffer)) and
1988        (aBuffer[Separator - 1] in ['0'..'9']) and
1989        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1990
1991       Dec(Separator);
1992       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1993         Dec(Separator);
1994
1995       Delete(aBuffer, 1, Separator);
1996       Separator := Pos(AnsiString('.'), aBuffer) + 1;
1997
1998       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
1999         Inc(Separator);
2000
2001       Delete(aBuffer, Separator, 255);
2002       Separator := Pos(AnsiString('.'), aBuffer);
2003
2004       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2005       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2006     end;
2007   end;
2008
2009   ///////////////////////////////////////////////////////////////////////////////////////////
2010   function CheckExtension(const Extension: AnsiString): Boolean;
2011   var
2012     ExtPos: Integer;
2013   begin
2014     ExtPos := Pos(Extension, Buffer);
2015     result := ExtPos > 0;
2016     if result then
2017       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2018   end;
2019
2020 begin
2021 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2022   InitOpenGLCS.Enter;
2023   try
2024     if not OpenGLInitialized then begin
2025       glbInitOpenGL;
2026       OpenGLInitialized := true;
2027     end;
2028   finally
2029     InitOpenGLCS.Leave;
2030   end;
2031 {$ENDIF}
2032
2033 {$IFDEF GLB_DELPHI}
2034   Context := wglGetCurrentContext;
2035   if (Context <> gLastContext) then begin
2036     gLastContext := Context;
2037 {$ENDIF}
2038
2039     // Version
2040     Buffer := glGetString(GL_VERSION);
2041     TrimVersionString(Buffer, MajorVersion, MinorVersion);
2042
2043     GL_VERSION_1_2 := false;
2044     GL_VERSION_1_3 := false;
2045     GL_VERSION_1_4 := false;
2046     GL_VERSION_2_0 := false;
2047     if MajorVersion = 1 then begin
2048       if MinorVersion >= 2 then
2049         GL_VERSION_1_2 := true;
2050
2051       if MinorVersion >= 3 then
2052         GL_VERSION_1_3 := true;
2053
2054       if MinorVersion >= 4 then
2055         GL_VERSION_1_4 := true;
2056     end else if MajorVersion >= 2 then begin
2057       GL_VERSION_1_2 := true;
2058       GL_VERSION_1_3 := true;
2059       GL_VERSION_1_4 := true;
2060       GL_VERSION_2_0 := true;
2061     end;
2062
2063     // Extensions
2064     Buffer := glGetString(GL_EXTENSIONS);
2065     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2066     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2067     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2068     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2069     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2070     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2071     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2072     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2073     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2074     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2075
2076     if GL_VERSION_1_3 then begin
2077       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2078       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2079       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2080     end else begin
2081       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2082       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2083       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2084     end;
2085 {$IFDEF GLB_DELPHI}
2086   end;
2087 {$ENDIF}
2088 end;
2089 {$ENDIF}
2090
2091 (* TODO GLB_DELPHI
2092 {$IFDEF GLB_DELPHI}
2093 function CreateGrayPalette: HPALETTE;
2094 var
2095   Idx: Integer;
2096   Pal: PLogPalette;
2097 begin
2098   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2099
2100   Pal.palVersion := $300;
2101   Pal.palNumEntries := 256;
2102
2103   {$IFOPT R+}
2104     {$DEFINE GLB_TEMPRANGECHECK}
2105     {$R-}
2106   {$ENDIF}
2107
2108   for Idx := 0 to 256 - 1 do begin
2109     Pal.palPalEntry[Idx].peRed   := Idx;
2110     Pal.palPalEntry[Idx].peGreen := Idx;
2111     Pal.palPalEntry[Idx].peBlue  := Idx;
2112     Pal.palPalEntry[Idx].peFlags := 0;
2113   end;
2114
2115   {$IFDEF GLB_TEMPRANGECHECK}
2116     {$UNDEF GLB_TEMPRANGECHECK}
2117     {$R+}
2118   {$ENDIF}
2119
2120   result := CreatePalette(Pal^);
2121
2122   FreeMem(Pal);
2123 end;
2124 {$ENDIF}
2125 *)
2126
2127 {$IFDEF GLB_SDL_IMAGE}
2128 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2129 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2130 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2131 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2132 begin
2133   result := TStream(context^.unknown.data1).Seek(offset, whence);
2134 end;
2135
2136 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2137 begin
2138   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2139 end;
2140
2141 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2142 begin
2143   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2144 end;
2145
2146 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2147 begin
2148   result := 0;
2149 end;
2150
2151 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2152 begin
2153   result := SDL_AllocRW;
2154
2155   if result = nil then
2156     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2157
2158   result^.seek := glBitmapRWseek;
2159   result^.read := glBitmapRWread;
2160   result^.write := glBitmapRWwrite;
2161   result^.close := glBitmapRWclose;
2162   result^.unknown.data1 := Stream;
2163 end;
2164 {$ENDIF}
2165
2166 (* TODO LoadFuncs
2167 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2168 var
2169   glBitmap: TglBitmap2D;
2170 begin
2171   result := false;
2172   Texture := 0;
2173
2174   {$IFDEF GLB_DELPHI}
2175   if Instance = 0 then
2176     Instance := HInstance;
2177
2178   if (LoadFromRes) then
2179     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
2180   else
2181   {$ENDIF}
2182     glBitmap := TglBitmap2D.Create(FileName);
2183
2184   try
2185     glBitmap.DeleteTextureOnFree := false;
2186     glBitmap.FreeDataAfterGenTexture := false;
2187     glBitmap.GenTexture(true);
2188     if (glBitmap.ID > 0) then begin
2189       Texture := glBitmap.ID;
2190       result := true;
2191     end;
2192   finally
2193     glBitmap.Free;
2194   end;
2195 end;
2196
2197 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2198 var
2199   CM: TglBitmapCubeMap;
2200 begin
2201   Texture := 0;
2202
2203   {$IFDEF GLB_DELPHI}
2204   if Instance = 0 then
2205     Instance := HInstance;
2206   {$ENDIF}
2207
2208   CM := TglBitmapCubeMap.Create;
2209   try
2210     CM.DeleteTextureOnFree := false;
2211
2212     // Maps
2213     {$IFDEF GLB_DELPHI}
2214     if (LoadFromRes) then
2215       CM.LoadFromResource(Instance, PositiveX)
2216     else
2217     {$ENDIF}
2218       CM.LoadFromFile(PositiveX);
2219     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
2220
2221     {$IFDEF GLB_DELPHI}
2222     if (LoadFromRes) then
2223       CM.LoadFromResource(Instance, NegativeX)
2224     else
2225     {$ENDIF}
2226       CM.LoadFromFile(NegativeX);
2227     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
2228
2229     {$IFDEF GLB_DELPHI}
2230     if (LoadFromRes) then
2231       CM.LoadFromResource(Instance, PositiveY)
2232     else
2233     {$ENDIF}
2234       CM.LoadFromFile(PositiveY);
2235     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
2236
2237     {$IFDEF GLB_DELPHI}
2238     if (LoadFromRes) then
2239       CM.LoadFromResource(Instance, NegativeY)
2240     else
2241     {$ENDIF}
2242       CM.LoadFromFile(NegativeY);
2243     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
2244
2245     {$IFDEF GLB_DELPHI}
2246     if (LoadFromRes) then
2247       CM.LoadFromResource(Instance, PositiveZ)
2248     else
2249     {$ENDIF}
2250       CM.LoadFromFile(PositiveZ);
2251     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2252
2253     {$IFDEF GLB_DELPHI}
2254     if (LoadFromRes) then
2255       CM.LoadFromResource(Instance, NegativeZ)
2256     else
2257     {$ENDIF}
2258       CM.LoadFromFile(NegativeZ);
2259     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2260
2261     Texture := CM.ID;
2262     result := true;
2263   finally
2264     CM.Free;
2265   end;
2266 end;
2267
2268 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2269 var
2270   NM: TglBitmapNormalMap;
2271 begin
2272   Texture := 0;
2273
2274   NM := TglBitmapNormalMap.Create;
2275   try
2276     NM.DeleteTextureOnFree := false;
2277     NM.GenerateNormalMap(Size);
2278
2279     Texture := NM.ID;
2280     result := true;
2281   finally
2282     NM.Free;
2283   end;
2284 end;
2285 *)
2286
2287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2288 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2289 begin
2290   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2291 end;
2292
2293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2294 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2295 begin
2296   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2297 end;
2298
2299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2300 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2301 begin
2302   glBitmapDefaultMipmap := aValue;
2303 end;
2304
2305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2306 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2307 begin
2308   glBitmapDefaultFormat := aFormat;
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2313 begin
2314   glBitmapDefaultFilterMin := aMin;
2315   glBitmapDefaultFilterMag := aMag;
2316 end;
2317
2318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2319 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2320 begin
2321   glBitmapDefaultWrapS := S;
2322   glBitmapDefaultWrapT := T;
2323   glBitmapDefaultWrapR := R;
2324 end;
2325
2326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2327 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2328 begin
2329   result := glBitmapDefaultDeleteTextureOnFree;
2330 end;
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2334 begin
2335   result := glBitmapDefaultFreeDataAfterGenTextures;
2336 end;
2337
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2340 begin
2341   result := glBitmapDefaultMipmap;
2342 end;
2343
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 function glBitmapGetDefaultFormat: TglBitmapFormat;
2346 begin
2347   result := glBitmapDefaultFormat;
2348 end;
2349
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2352 begin
2353   aMin := glBitmapDefaultFilterMin;
2354   aMag := glBitmapDefaultFilterMag;
2355 end;
2356
2357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2359 begin
2360   S := glBitmapDefaultWrapS;
2361   T := glBitmapDefaultWrapT;
2362   R := glBitmapDefaultWrapR;
2363 end;
2364
2365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2366 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2368 function TFormatDescriptor.GetRedMask: QWord;
2369 begin
2370   result := fRange.r shl fShift.r;
2371 end;
2372
2373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2374 function TFormatDescriptor.GetGreenMask: QWord;
2375 begin
2376   result := fRange.g shl fShift.g;
2377 end;
2378
2379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2380 function TFormatDescriptor.GetBlueMask: QWord;
2381 begin
2382   result := fRange.b shl fShift.b;
2383 end;
2384
2385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2386 function TFormatDescriptor.GetAlphaMask: QWord;
2387 begin
2388   result := fRange.a shl fShift.a;
2389 end;
2390
2391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2392 function TFormatDescriptor.GetComponents: Integer;
2393 var
2394   i: Integer;
2395 begin
2396   result := 0;
2397   for i := 0 to 3 do
2398     if (fRange.arr[i] > 0) then
2399       inc(result);
2400 end;
2401
2402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2403 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2404 var
2405   w, h: Integer;
2406 begin
2407   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2408     w := Max(1, aSize.X);
2409     h := Max(1, aSize.Y);
2410     result := GetSize(w, h);
2411   end else
2412     result := 0;
2413 end;
2414
2415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2416 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2417 begin
2418   result := 0;
2419   if (aWidth <= 0) or (aHeight <= 0) then
2420     exit;
2421   result := Ceil(aWidth * aHeight * fPixelSize);
2422 end;
2423
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 function TFormatDescriptor.CreateMappingData: Pointer;
2426 begin
2427   result := nil;
2428 end;
2429
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2432 begin
2433   //DUMMY
2434 end;
2435
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 function TFormatDescriptor.IsEmpty: Boolean;
2438 begin
2439   result := (fFormat = tfEmpty);
2440 end;
2441
2442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 function TFormatDescriptor.HasAlpha: Boolean;
2444 begin
2445   result := (fRange.a > 0);
2446 end;
2447
2448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2450 begin
2451   result := false;
2452
2453   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2454     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2455
2456   if (aRedMask   <> RedMask) then
2457     exit;
2458   if (aGreenMask <> GreenMask) then
2459     exit;
2460   if (aBlueMask  <> BlueMask) then
2461     exit;
2462   if (aAlphaMask <> AlphaMask) then
2463     exit;
2464   result := true;
2465 end;
2466
2467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2468 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2469 begin
2470   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2471   aPixel.Data   := fRange;
2472   aPixel.Range  := fRange;
2473   aPixel.Format := fFormat;
2474 end;
2475
2476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2477 constructor TFormatDescriptor.Create;
2478 begin
2479   inherited Create;
2480
2481   fFormat       := tfEmpty;
2482   fWithAlpha    := tfEmpty;
2483   fWithoutAlpha := tfEmpty;
2484   fRGBInverted  := tfEmpty;
2485   fUncompressed := tfEmpty;
2486   fPixelSize    := 0.0;
2487   fIsCompressed := false;
2488
2489   fglFormat         := 0;
2490   fglInternalFormat := 0;
2491   fglDataFormat     := 0;
2492
2493   FillChar(fRange, 0, SizeOf(fRange));
2494   FillChar(fShift, 0, SizeOf(fShift));
2495 end;
2496
2497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2498 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2500 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2501 begin
2502   aData^ := aPixel.Data.a;
2503   inc(aData);
2504 end;
2505
2506 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2507 begin
2508   aPixel.Data.r := 0;
2509   aPixel.Data.g := 0;
2510   aPixel.Data.b := 0;
2511   aPixel.Data.a := aData^;
2512   inc(aData^);
2513 end;
2514
2515 constructor TfdAlpha_UB1.Create;
2516 begin
2517   inherited Create;
2518   fPixelSize        := 1.0;
2519   fRange.a          := $FF;
2520   fglFormat         := GL_ALPHA;
2521   fglDataFormat     := GL_UNSIGNED_BYTE;
2522 end;
2523
2524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2525 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2527 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2528 begin
2529   aData^ := LuminanceWeight(aPixel);
2530   inc(aData);
2531 end;
2532
2533 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2534 begin
2535   aPixel.Data.r := aData^;
2536   aPixel.Data.g := aData^;
2537   aPixel.Data.b := aData^;
2538   aPixel.Data.a := 0;
2539   inc(aData);
2540 end;
2541
2542 constructor TfdLuminance_UB1.Create;
2543 begin
2544   inherited Create;
2545   fPixelSize        := 1.0;
2546   fRange.r          := $FF;
2547   fRange.g          := $FF;
2548   fRange.b          := $FF;
2549   fglFormat         := GL_LUMINANCE;
2550   fglDataFormat     := GL_UNSIGNED_BYTE;
2551 end;
2552
2553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2554 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2557 var
2558   i: Integer;
2559 begin
2560   aData^ := 0;
2561   for i := 0 to 3 do
2562     if (fRange.arr[i] > 0) then
2563       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2564   inc(aData);
2565 end;
2566
2567 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2568 var
2569   i: Integer;
2570 begin
2571   for i := 0 to 3 do
2572     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2573   inc(aData);
2574 end;
2575
2576 constructor TfdUniversal_UB1.Create;
2577 begin
2578   inherited Create;
2579   fPixelSize := 1.0;
2580 end;
2581
2582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2585 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2586 begin
2587   inherited Map(aPixel, aData, aMapData);
2588   aData^ := aPixel.Data.a;
2589   inc(aData);
2590 end;
2591
2592 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2593 begin
2594   inherited Unmap(aData, aPixel, aMapData);
2595   aPixel.Data.a := aData^;
2596   inc(aData);
2597 end;
2598
2599 constructor TfdLuminanceAlpha_UB2.Create;
2600 begin
2601   inherited Create;
2602   fPixelSize        := 2.0;
2603   fRange.a          := $FF;
2604   fShift.a          :=   8;
2605   fglFormat         := GL_LUMINANCE_ALPHA;
2606   fglDataFormat     := GL_UNSIGNED_BYTE;
2607 end;
2608
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2613 begin
2614   aData^ := aPixel.Data.r;
2615   inc(aData);
2616   aData^ := aPixel.Data.g;
2617   inc(aData);
2618   aData^ := aPixel.Data.b;
2619   inc(aData);
2620 end;
2621
2622 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2623 begin
2624   aPixel.Data.r := aData^;
2625   inc(aData);
2626   aPixel.Data.g := aData^;
2627   inc(aData);
2628   aPixel.Data.b := aData^;
2629   inc(aData);
2630   aPixel.Data.a := 0;
2631 end;
2632
2633 constructor TfdRGB_UB3.Create;
2634 begin
2635   inherited Create;
2636   fPixelSize        := 3.0;
2637   fRange.r          := $FF;
2638   fRange.g          := $FF;
2639   fRange.b          := $FF;
2640   fShift.r          :=   0;
2641   fShift.g          :=   8;
2642   fShift.b          :=  16;
2643   fglFormat         := GL_RGB;
2644   fglDataFormat     := GL_UNSIGNED_BYTE;
2645 end;
2646
2647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2650 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2651 begin
2652   aData^ := aPixel.Data.b;
2653   inc(aData);
2654   aData^ := aPixel.Data.g;
2655   inc(aData);
2656   aData^ := aPixel.Data.r;
2657   inc(aData);
2658 end;
2659
2660 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2661 begin
2662   aPixel.Data.b := aData^;
2663   inc(aData);
2664   aPixel.Data.g := aData^;
2665   inc(aData);
2666   aPixel.Data.r := aData^;
2667   inc(aData);
2668   aPixel.Data.a := 0;
2669 end;
2670
2671 constructor TfdBGR_UB3.Create;
2672 begin
2673   fPixelSize        := 3.0;
2674   fRange.r          := $FF;
2675   fRange.g          := $FF;
2676   fRange.b          := $FF;
2677   fShift.r          :=  16;
2678   fShift.g          :=   8;
2679   fShift.b          :=   0;
2680   fglFormat         := GL_BGR;
2681   fglDataFormat     := GL_UNSIGNED_BYTE;
2682 end;
2683
2684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2685 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2687 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2688 begin
2689   inherited Map(aPixel, aData, aMapData);
2690   aData^ := aPixel.Data.a;
2691   inc(aData);
2692 end;
2693
2694 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2695 begin
2696   inherited Unmap(aData, aPixel, aMapData);
2697   aPixel.Data.a := aData^;
2698   inc(aData);
2699 end;
2700
2701 constructor TfdRGBA_UB4.Create;
2702 begin
2703   inherited Create;
2704   fPixelSize        := 4.0;
2705   fRange.a          := $FF;
2706   fShift.a          :=  24;
2707   fglFormat         := GL_RGBA;
2708   fglDataFormat     := GL_UNSIGNED_BYTE;
2709 end;
2710
2711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2712 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2714 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2715 begin
2716   inherited Map(aPixel, aData, aMapData);
2717   aData^ := aPixel.Data.a;
2718   inc(aData);
2719 end;
2720
2721 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2722 begin
2723   inherited Unmap(aData, aPixel, aMapData);
2724   aPixel.Data.a := aData^;
2725   inc(aData);
2726 end;
2727
2728 constructor TfdBGRA_UB4.Create;
2729 begin
2730   inherited Create;
2731   fPixelSize        := 4.0;
2732   fRange.a          := $FF;
2733   fShift.a          :=  24;
2734   fglFormat         := GL_BGRA;
2735   fglDataFormat     := GL_UNSIGNED_BYTE;
2736 end;
2737
2738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2739 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2742 begin
2743   PWord(aData)^ := aPixel.Data.a;
2744   inc(aData, 2);
2745 end;
2746
2747 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2748 begin
2749   aPixel.Data.r := 0;
2750   aPixel.Data.g := 0;
2751   aPixel.Data.b := 0;
2752   aPixel.Data.a := PWord(aData)^;
2753   inc(aData, 2);
2754 end;
2755
2756 constructor TfdAlpha_US1.Create;
2757 begin
2758   inherited Create;
2759   fPixelSize        := 2.0;
2760   fRange.a          := $FFFF;
2761   fglFormat         := GL_ALPHA;
2762   fglDataFormat     := GL_UNSIGNED_SHORT;
2763 end;
2764
2765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2766 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2768 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2769 begin
2770   PWord(aData)^ := LuminanceWeight(aPixel);
2771   inc(aData, 2);
2772 end;
2773
2774 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2775 begin
2776   aPixel.Data.r := PWord(aData)^;
2777   aPixel.Data.g := PWord(aData)^;
2778   aPixel.Data.b := PWord(aData)^;
2779   aPixel.Data.a := 0;
2780   inc(aData, 2);
2781 end;
2782
2783 constructor TfdLuminance_US1.Create;
2784 begin
2785   inherited Create;
2786   fPixelSize        := 2.0;
2787   fRange.r          := $FFFF;
2788   fRange.g          := $FFFF;
2789   fRange.b          := $FFFF;
2790   fglFormat         := GL_LUMINANCE;
2791   fglDataFormat     := GL_UNSIGNED_SHORT;
2792 end;
2793
2794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2795 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2797 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2798 var
2799   i: Integer;
2800 begin
2801   PWord(aData)^ := 0;
2802   for i := 0 to 3 do
2803     if (fRange.arr[i] > 0) then
2804       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2805   inc(aData, 2);
2806 end;
2807
2808 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2809 var
2810   i: Integer;
2811 begin
2812   for i := 0 to 3 do
2813     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2814   inc(aData, 2);
2815 end;
2816
2817 constructor TfdUniversal_US1.Create;
2818 begin
2819   inherited Create;
2820   fPixelSize := 2.0;
2821 end;
2822
2823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2824 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2826 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2827 begin
2828   PWord(aData)^ := DepthWeight(aPixel);
2829   inc(aData, 2);
2830 end;
2831
2832 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2833 begin
2834   aPixel.Data.r := PWord(aData)^;
2835   aPixel.Data.g := PWord(aData)^;
2836   aPixel.Data.b := PWord(aData)^;
2837   aPixel.Data.a := 0;
2838   inc(aData, 2);
2839 end;
2840
2841 constructor TfdDepth_US1.Create;
2842 begin
2843   inherited Create;
2844   fPixelSize        := 2.0;
2845   fRange.r          := $FFFF;
2846   fRange.g          := $FFFF;
2847   fRange.b          := $FFFF;
2848   fglFormat         := GL_DEPTH_COMPONENT;
2849   fglDataFormat     := GL_UNSIGNED_SHORT;
2850 end;
2851
2852 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2853 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2855 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2856 begin
2857   inherited Map(aPixel, aData, aMapData);
2858   PWord(aData)^ := aPixel.Data.a;
2859   inc(aData, 2);
2860 end;
2861
2862 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2863 begin
2864   inherited Unmap(aData, aPixel, aMapData);
2865   aPixel.Data.a := PWord(aData)^;
2866   inc(aData, 2);
2867 end;
2868
2869 constructor TfdLuminanceAlpha_US2.Create;
2870 begin
2871   inherited Create;
2872   fPixelSize        :=   4.0;
2873   fRange.a          := $FFFF;
2874   fShift.a          :=    16;
2875   fglFormat         := GL_LUMINANCE_ALPHA;
2876   fglDataFormat     := GL_UNSIGNED_SHORT;
2877 end;
2878
2879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2880 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2883 begin
2884   PWord(aData)^ := aPixel.Data.r;
2885   inc(aData, 2);
2886   PWord(aData)^ := aPixel.Data.g;
2887   inc(aData, 2);
2888   PWord(aData)^ := aPixel.Data.b;
2889   inc(aData, 2);
2890 end;
2891
2892 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2893 begin
2894   aPixel.Data.r := PWord(aData)^;
2895   inc(aData, 2);
2896   aPixel.Data.g := PWord(aData)^;
2897   inc(aData, 2);
2898   aPixel.Data.b := PWord(aData)^;
2899   inc(aData, 2);
2900   aPixel.Data.a := 0;
2901 end;
2902
2903 constructor TfdRGB_US3.Create;
2904 begin
2905   inherited Create;
2906   fPixelSize        :=   6.0;
2907   fRange.r          := $FFFF;
2908   fRange.g          := $FFFF;
2909   fRange.b          := $FFFF;
2910   fShift.r          :=     0;
2911   fShift.g          :=    16;
2912   fShift.b          :=    32;
2913   fglFormat         := GL_RGB;
2914   fglDataFormat     := GL_UNSIGNED_SHORT;
2915 end;
2916
2917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2918 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2919 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2920 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2921 begin
2922   PWord(aData)^ := aPixel.Data.b;
2923   inc(aData, 2);
2924   PWord(aData)^ := aPixel.Data.g;
2925   inc(aData, 2);
2926   PWord(aData)^ := aPixel.Data.r;
2927   inc(aData, 2);
2928 end;
2929
2930 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2931 begin
2932   aPixel.Data.b := PWord(aData)^;
2933   inc(aData, 2);
2934   aPixel.Data.g := PWord(aData)^;
2935   inc(aData, 2);
2936   aPixel.Data.r := PWord(aData)^;
2937   inc(aData, 2);
2938   aPixel.Data.a := 0;
2939 end;
2940
2941 constructor TfdBGR_US3.Create;
2942 begin
2943   inherited Create;
2944   fPixelSize        :=   6.0;
2945   fRange.r          := $FFFF;
2946   fRange.g          := $FFFF;
2947   fRange.b          := $FFFF;
2948   fShift.r          :=    32;
2949   fShift.g          :=    16;
2950   fShift.b          :=     0;
2951   fglFormat         := GL_BGR;
2952   fglDataFormat     := GL_UNSIGNED_SHORT;
2953 end;
2954
2955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2956 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2958 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2959 begin
2960   inherited Map(aPixel, aData, aMapData);
2961   PWord(aData)^ := aPixel.Data.a;
2962   inc(aData, 2);
2963 end;
2964
2965 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2966 begin
2967   inherited Unmap(aData, aPixel, aMapData);
2968   aPixel.Data.a := PWord(aData)^;
2969   inc(aData, 2);
2970 end;
2971
2972 constructor TfdRGBA_US4.Create;
2973 begin
2974   inherited Create;
2975   fPixelSize        :=   8.0;
2976   fRange.a          := $FFFF;
2977   fShift.a          :=    48;
2978   fglFormat         := GL_RGBA;
2979   fglDataFormat     := GL_UNSIGNED_SHORT;
2980 end;
2981
2982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2983 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2985 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2986 begin
2987   inherited Map(aPixel, aData, aMapData);
2988   PWord(aData)^ := aPixel.Data.a;
2989   inc(aData, 2);
2990 end;
2991
2992 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2993 begin
2994   inherited Unmap(aData, aPixel, aMapData);
2995   aPixel.Data.a := PWord(aData)^;
2996   inc(aData, 2);
2997 end;
2998
2999 constructor TfdBGRA_US4.Create;
3000 begin
3001   inherited Create;
3002   fPixelSize        :=   8.0;
3003   fRange.a          := $FFFF;
3004   fShift.a          :=    48;
3005   fglFormat         := GL_BGRA;
3006   fglDataFormat     := GL_UNSIGNED_SHORT;
3007 end;
3008
3009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3010 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3012 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3013 var
3014   i: Integer;
3015 begin
3016   PCardinal(aData)^ := 0;
3017   for i := 0 to 3 do
3018     if (fRange.arr[i] > 0) then
3019       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3020   inc(aData, 4);
3021 end;
3022
3023 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3024 var
3025   i: Integer;
3026 begin
3027   for i := 0 to 3 do
3028     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3029   inc(aData, 2);
3030 end;
3031
3032 constructor TfdUniversal_UI1.Create;
3033 begin
3034   inherited Create;
3035   fPixelSize := 4.0;
3036 end;
3037
3038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3039 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3041 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3042 begin
3043   PCardinal(aData)^ := DepthWeight(aPixel);
3044   inc(aData, 4);
3045 end;
3046
3047 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3048 begin
3049   aPixel.Data.r := PCardinal(aData)^;
3050   aPixel.Data.g := PCardinal(aData)^;
3051   aPixel.Data.b := PCardinal(aData)^;
3052   aPixel.Data.a := 0;
3053   inc(aData, 4);
3054 end;
3055
3056 constructor TfdDepth_UI1.Create;
3057 begin
3058   inherited Create;
3059   fPixelSize        := 4.0;
3060   fRange.r          := $FFFFFFFF;
3061   fRange.g          := $FFFFFFFF;
3062   fRange.b          := $FFFFFFFF;
3063   fglFormat         := GL_DEPTH_COMPONENT;
3064   fglDataFormat     := GL_UNSIGNED_INT;
3065 end;
3066
3067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3070 constructor TfdAlpha4.Create;
3071 begin
3072   inherited Create;
3073   fFormat           := tfAlpha4;
3074   fWithAlpha        := tfAlpha4;
3075   fglInternalFormat := GL_ALPHA4;
3076 end;
3077
3078 constructor TfdAlpha8.Create;
3079 begin
3080   inherited Create;
3081   fFormat           := tfAlpha8;
3082   fWithAlpha        := tfAlpha8;
3083   fglInternalFormat := GL_ALPHA8;
3084 end;
3085
3086 constructor TfdAlpha12.Create;
3087 begin
3088   inherited Create;
3089   fFormat           := tfAlpha12;
3090   fWithAlpha        := tfAlpha12;
3091   fglInternalFormat := GL_ALPHA12;
3092 end;
3093
3094 constructor TfdAlpha16.Create;
3095 begin
3096   inherited Create;
3097   fFormat           := tfAlpha16;
3098   fWithAlpha        := tfAlpha16;
3099   fglInternalFormat := GL_ALPHA16;
3100 end;
3101
3102 constructor TfdLuminance4.Create;
3103 begin
3104   inherited Create;
3105   fFormat           := tfLuminance4;
3106   fWithAlpha        := tfLuminance4Alpha4;
3107   fWithoutAlpha     := tfLuminance4;
3108   fglInternalFormat := GL_LUMINANCE4;
3109 end;
3110
3111 constructor TfdLuminance8.Create;
3112 begin
3113   inherited Create;
3114   fFormat           := tfLuminance8;
3115   fWithAlpha        := tfLuminance8Alpha8;
3116   fWithoutAlpha     := tfLuminance8;
3117   fglInternalFormat := GL_LUMINANCE8;
3118 end;
3119
3120 constructor TfdLuminance12.Create;
3121 begin
3122   inherited Create;
3123   fFormat           := tfLuminance12;
3124   fWithAlpha        := tfLuminance12Alpha12;
3125   fWithoutAlpha     := tfLuminance12;
3126   fglInternalFormat := GL_LUMINANCE12;
3127 end;
3128
3129 constructor TfdLuminance16.Create;
3130 begin
3131   inherited Create;
3132   fFormat           := tfLuminance16;
3133   fWithAlpha        := tfLuminance16Alpha16;
3134   fWithoutAlpha     := tfLuminance16;
3135   fglInternalFormat := GL_LUMINANCE16;
3136 end;
3137
3138 constructor TfdLuminance4Alpha4.Create;
3139 begin
3140   inherited Create;
3141   fFormat           := tfLuminance4Alpha4;
3142   fWithAlpha        := tfLuminance4Alpha4;
3143   fWithoutAlpha     := tfLuminance4;
3144   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3145 end;
3146
3147 constructor TfdLuminance6Alpha2.Create;
3148 begin
3149   inherited Create;
3150   fFormat           := tfLuminance6Alpha2;
3151   fWithAlpha        := tfLuminance6Alpha2;
3152   fWithoutAlpha     := tfLuminance8;
3153   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3154 end;
3155
3156 constructor TfdLuminance8Alpha8.Create;
3157 begin
3158   inherited Create;
3159   fFormat           := tfLuminance8Alpha8;
3160   fWithAlpha        := tfLuminance8Alpha8;
3161   fWithoutAlpha     := tfLuminance8;
3162   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3163 end;
3164
3165 constructor TfdLuminance12Alpha4.Create;
3166 begin
3167   inherited Create;
3168   fFormat           := tfLuminance12Alpha4;
3169   fWithAlpha        := tfLuminance12Alpha4;
3170   fWithoutAlpha     := tfLuminance12;
3171   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3172 end;
3173
3174 constructor TfdLuminance12Alpha12.Create;
3175 begin
3176   inherited Create;
3177   fFormat           := tfLuminance12Alpha12;
3178   fWithAlpha        := tfLuminance12Alpha12;
3179   fWithoutAlpha     := tfLuminance12;
3180   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3181 end;
3182
3183 constructor TfdLuminance16Alpha16.Create;
3184 begin
3185   inherited Create;
3186   fFormat           := tfLuminance16Alpha16;
3187   fWithAlpha        := tfLuminance16Alpha16;
3188   fWithoutAlpha     := tfLuminance16;
3189   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3190 end;
3191
3192 constructor TfdR3G3B2.Create;
3193 begin
3194   inherited Create;
3195   fFormat           := tfR3G3B2;
3196   fWithAlpha        := tfRGBA2;
3197   fWithoutAlpha     := tfR3G3B2;
3198   fRange.r          := $7;
3199   fRange.g          := $7;
3200   fRange.b          := $3;
3201   fShift.r          :=  0;
3202   fShift.g          :=  3;
3203   fShift.b          :=  6;
3204   fglFormat         := GL_RGB;
3205   fglInternalFormat := GL_R3_G3_B2;
3206   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3207 end;
3208
3209 constructor TfdRGB4.Create;
3210 begin
3211   inherited Create;
3212   fFormat           := tfRGB4;
3213   fWithAlpha        := tfRGBA4;
3214   fWithoutAlpha     := tfRGB4;
3215   fRGBInverted      := tfBGR4;
3216   fRange.r          := $F;
3217   fRange.g          := $F;
3218   fRange.b          := $F;
3219   fShift.r          :=  0;
3220   fShift.g          :=  4;
3221   fShift.b          :=  8;
3222   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3223   fglInternalFormat := GL_RGB4;
3224   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3225 end;
3226
3227 constructor TfdR5G6B5.Create;
3228 begin
3229   inherited Create;
3230   fFormat           := tfR5G6B5;
3231   fWithAlpha        := tfRGBA4;
3232   fWithoutAlpha     := tfR5G6B5;
3233   fRGBInverted      := tfB5G6R5;
3234   fRange.r          := $1F;
3235   fRange.g          := $3F;
3236   fRange.b          := $1F;
3237   fShift.r          :=   0;
3238   fShift.g          :=   5;
3239   fShift.b          :=  11;
3240   fglFormat         := GL_RGB;
3241   fglInternalFormat := GL_RGB565;
3242   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3243 end;
3244
3245 constructor TfdRGB5.Create;
3246 begin
3247   inherited Create;
3248   fFormat           := tfRGB5;
3249   fWithAlpha        := tfRGB5A1;
3250   fWithoutAlpha     := tfRGB5;
3251   fRGBInverted      := tfBGR5;
3252   fRange.r          := $1F;
3253   fRange.g          := $1F;
3254   fRange.b          := $1F;
3255   fShift.r          :=   0;
3256   fShift.g          :=   5;
3257   fShift.b          :=  10;
3258   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3259   fglInternalFormat := GL_RGB5;
3260   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3261 end;
3262
3263 constructor TfdRGB8.Create;
3264 begin
3265   inherited Create;
3266   fFormat           := tfRGB8;
3267   fWithAlpha        := tfRGBA8;
3268   fWithoutAlpha     := tfRGB8;
3269   fRGBInverted      := tfBGR8;
3270   fglInternalFormat := GL_RGB8;
3271 end;
3272
3273 constructor TfdRGB10.Create;
3274 begin
3275   inherited Create;
3276   fFormat           := tfRGB10;
3277   fWithAlpha        := tfRGB10A2;
3278   fWithoutAlpha     := tfRGB10;
3279   fRGBInverted      := tfBGR10;
3280   fRange.r          := $3FF;
3281   fRange.g          := $3FF;
3282   fRange.b          := $3FF;
3283   fShift.r          :=    0;
3284   fShift.g          :=   10;
3285   fShift.b          :=   20;
3286   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3287   fglInternalFormat := GL_RGB10;
3288   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3289 end;
3290
3291 constructor TfdRGB12.Create;
3292 begin
3293   inherited Create;
3294   fFormat           := tfRGB12;
3295   fWithAlpha        := tfRGBA12;
3296   fWithoutAlpha     := tfRGB12;
3297   fRGBInverted      := tfBGR12;
3298   fglInternalFormat := GL_RGB12;
3299 end;
3300
3301 constructor TfdRGB16.Create;
3302 begin
3303   inherited Create;
3304   fFormat           := tfRGB16;
3305   fWithAlpha        := tfRGBA16;
3306   fWithoutAlpha     := tfRGB16;
3307   fRGBInverted      := tfBGR16;
3308   fglInternalFormat := GL_RGB16;
3309 end;
3310
3311 constructor TfdRGBA2.Create;
3312 begin
3313   inherited Create;
3314   fFormat           := tfRGBA2;
3315   fWithAlpha        := tfRGBA2;
3316   fWithoutAlpha     := tfR3G3B2;
3317   fRGBInverted      := tfBGRA2;
3318   fglInternalFormat := GL_RGBA2;
3319 end;
3320
3321 constructor TfdRGBA4.Create;
3322 begin
3323   inherited Create;
3324   fFormat           := tfRGBA4;
3325   fWithAlpha        := tfRGBA4;
3326   fWithoutAlpha     := tfRGB4;
3327   fRGBInverted      := tfBGRA4;
3328   fRange.r          := $F;
3329   fRange.g          := $F;
3330   fRange.b          := $F;
3331   fRange.a          := $F;
3332   fShift.r          :=  0;
3333   fShift.g          :=  4;
3334   fShift.b          :=  8;
3335   fShift.a          := 12;
3336   fglFormat         := GL_RGBA;
3337   fglInternalFormat := GL_RGBA4;
3338   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3339 end;
3340
3341 constructor TfdRGB5A1.Create;
3342 begin
3343   inherited Create;
3344   fFormat           := tfRGB5A1;
3345   fWithAlpha        := tfRGB5A1;
3346   fWithoutAlpha     := tfRGB5;
3347   fRGBInverted      := tfBGR5A1;
3348   fRange.r          := $1F;
3349   fRange.g          := $1F;
3350   fRange.b          := $1F;
3351   fRange.a          := $01;
3352   fShift.r          :=   0;
3353   fShift.g          :=   5;
3354   fShift.b          :=  10;
3355   fShift.a          :=  15;
3356   fglFormat         := GL_RGBA;
3357   fglInternalFormat := GL_RGB5_A1;
3358   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3359 end;
3360
3361 constructor TfdRGBA8.Create;
3362 begin
3363   inherited Create;
3364   fFormat           := tfRGBA8;
3365   fWithAlpha        := tfRGBA8;
3366   fWithoutAlpha     := tfRGB8;
3367   fRGBInverted      := tfBGRA8;
3368   fglInternalFormat := GL_RGBA8;
3369 end;
3370
3371 constructor TfdRGB10A2.Create;
3372 begin
3373   inherited Create;
3374   fFormat           := tfRGB10A2;
3375   fWithAlpha        := tfRGB10A2;
3376   fWithoutAlpha     := tfRGB10;
3377   fRGBInverted      := tfBGR10A2;
3378   fRange.r          := $3FF;
3379   fRange.g          := $3FF;
3380   fRange.b          := $3FF;
3381   fRange.a          := $003;
3382   fShift.r          :=    0;
3383   fShift.g          :=   10;
3384   fShift.b          :=   20;
3385   fShift.a          :=   30;
3386   fglFormat         := GL_RGBA;
3387   fglInternalFormat := GL_RGB10_A2;
3388   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3389 end;
3390
3391 constructor TfdRGBA12.Create;
3392 begin
3393   inherited Create;
3394   fFormat           := tfRGBA12;
3395   fWithAlpha        := tfRGBA12;
3396   fWithoutAlpha     := tfRGB12;
3397   fRGBInverted      := tfBGRA12;
3398   fglInternalFormat := GL_RGBA12;
3399 end;
3400
3401 constructor TfdRGBA16.Create;
3402 begin
3403   inherited Create;
3404   fFormat           := tfRGBA16;
3405   fWithAlpha        := tfRGBA16;
3406   fWithoutAlpha     := tfRGB16;
3407   fRGBInverted      := tfBGRA16;
3408   fglInternalFormat := GL_RGBA16;
3409 end;
3410
3411 constructor TfdBGR4.Create;
3412 begin
3413   inherited Create;
3414   fPixelSize        := 2.0;
3415   fFormat           := tfBGR4;
3416   fWithAlpha        := tfBGRA4;
3417   fWithoutAlpha     := tfBGR4;
3418   fRGBInverted      := tfRGB4;
3419   fRange.r          := $F;
3420   fRange.g          := $F;
3421   fRange.b          := $F;
3422   fRange.a          := $0;
3423   fShift.r          :=  8;
3424   fShift.g          :=  4;
3425   fShift.b          :=  0;
3426   fShift.a          :=  0;
3427   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3428   fglInternalFormat := GL_RGB4;
3429   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3430 end;
3431
3432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3435 constructor TfdB5G6R5.Create;
3436 begin
3437   inherited Create;
3438   fFormat           := tfB5G6R5;
3439   fWithAlpha        := tfBGRA4;
3440   fWithoutAlpha     := tfB5G6R5;
3441   fRGBInverted      := tfR5G6B5;
3442   fRange.r          := $1F;
3443   fRange.g          := $3F;
3444   fRange.b          := $1F;
3445   fShift.r          :=  11;
3446   fShift.g          :=   5;
3447   fShift.b          :=   0;
3448   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3449   fglInternalFormat := GL_RGB8;
3450   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3451 end;
3452
3453 constructor TfdBGR5.Create;
3454 begin
3455   inherited Create;
3456   fPixelSize        := 2.0;
3457   fFormat           := tfBGR5;
3458   fWithAlpha        := tfBGR5A1;
3459   fWithoutAlpha     := tfBGR5;
3460   fRGBInverted      := tfRGB5;
3461   fRange.r          := $1F;
3462   fRange.g          := $1F;
3463   fRange.b          := $1F;
3464   fRange.a          := $00;
3465   fShift.r          :=  10;
3466   fShift.g          :=   5;
3467   fShift.b          :=   0;
3468   fShift.a          :=   0;
3469   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3470   fglInternalFormat := GL_RGB5;
3471   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3472 end;
3473
3474 constructor TfdBGR8.Create;
3475 begin
3476   inherited Create;
3477   fFormat           := tfBGR8;
3478   fWithAlpha        := tfBGRA8;
3479   fWithoutAlpha     := tfBGR8;
3480   fRGBInverted      := tfRGB8;
3481   fglInternalFormat := GL_RGB8;
3482 end;
3483
3484 constructor TfdBGR10.Create;
3485 begin
3486   inherited Create;
3487   fFormat           := tfBGR10;
3488   fWithAlpha        := tfBGR10A2;
3489   fWithoutAlpha     := tfBGR10;
3490   fRGBInverted      := tfRGB10;
3491   fRange.r          := $3FF;
3492   fRange.g          := $3FF;
3493   fRange.b          := $3FF;
3494   fRange.a          := $000;
3495   fShift.r          :=   20;
3496   fShift.g          :=   10;
3497   fShift.b          :=    0;
3498   fShift.a          :=    0;
3499   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3500   fglInternalFormat := GL_RGB10;
3501   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3502 end;
3503
3504 constructor TfdBGR12.Create;
3505 begin
3506   inherited Create;
3507   fFormat           := tfBGR12;
3508   fWithAlpha        := tfBGRA12;
3509   fWithoutAlpha     := tfBGR12;
3510   fRGBInverted      := tfRGB12;
3511   fglInternalFormat := GL_RGB12;
3512 end;
3513
3514 constructor TfdBGR16.Create;
3515 begin
3516   inherited Create;
3517   fFormat           := tfBGR16;
3518   fWithAlpha        := tfBGRA16;
3519   fWithoutAlpha     := tfBGR16;
3520   fRGBInverted      := tfRGB16;
3521   fglInternalFormat := GL_RGB16;
3522 end;
3523
3524 constructor TfdBGRA2.Create;
3525 begin
3526   inherited Create;
3527   fFormat           := tfBGRA2;
3528   fWithAlpha        := tfBGRA4;
3529   fWithoutAlpha     := tfBGR4;
3530   fRGBInverted      := tfRGBA2;
3531   fglInternalFormat := GL_RGBA2;
3532 end;
3533
3534 constructor TfdBGRA4.Create;
3535 begin
3536   inherited Create;
3537   fFormat           := tfBGRA4;
3538   fWithAlpha        := tfBGRA4;
3539   fWithoutAlpha     := tfBGR4;
3540   fRGBInverted      := tfRGBA4;
3541   fRange.r          := $F;
3542   fRange.g          := $F;
3543   fRange.b          := $F;
3544   fRange.a          := $F;
3545   fShift.r          :=  8;
3546   fShift.g          :=  4;
3547   fShift.b          :=  0;
3548   fShift.a          := 12;
3549   fglFormat         := GL_BGRA;
3550   fglInternalFormat := GL_RGBA4;
3551   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3552 end;
3553
3554 constructor TfdBGR5A1.Create;
3555 begin
3556   inherited Create;
3557   fFormat           := tfBGR5A1;
3558   fWithAlpha        := tfBGR5A1;
3559   fWithoutAlpha     := tfBGR5;
3560   fRGBInverted      := tfRGB5A1;
3561   fRange.r          := $1F;
3562   fRange.g          := $1F;
3563   fRange.b          := $1F;
3564   fRange.a          := $01;
3565   fShift.r          :=  10;
3566   fShift.g          :=   5;
3567   fShift.b          :=   0;
3568   fShift.a          :=  15;
3569   fglFormat         := GL_BGRA;
3570   fglInternalFormat := GL_RGB5_A1;
3571   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3572 end;
3573
3574 constructor TfdBGRA8.Create;
3575 begin
3576   inherited Create;
3577   fFormat           := tfBGRA8;
3578   fWithAlpha        := tfBGRA8;
3579   fWithoutAlpha     := tfBGR8;
3580   fRGBInverted      := tfRGBA8;
3581   fglInternalFormat := GL_RGBA8;
3582 end;
3583
3584 constructor TfdBGR10A2.Create;
3585 begin
3586   inherited Create;
3587   fFormat           := tfBGR10A2;
3588   fWithAlpha        := tfBGR10A2;
3589   fWithoutAlpha     := tfBGR10;
3590   fRGBInverted      := tfRGB10A2;
3591   fRange.r          := $3FF;
3592   fRange.g          := $3FF;
3593   fRange.b          := $3FF;
3594   fRange.a          := $003;
3595   fShift.r          :=   20;
3596   fShift.g          :=   10;
3597   fShift.b          :=    0;
3598   fShift.a          :=   30;
3599   fglFormat         := GL_BGRA;
3600   fglInternalFormat := GL_RGB10_A2;
3601   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3602 end;
3603
3604 constructor TfdBGRA12.Create;
3605 begin
3606   inherited Create;
3607   fFormat           := tfBGRA12;
3608   fWithAlpha        := tfBGRA12;
3609   fWithoutAlpha     := tfBGR12;
3610   fRGBInverted      := tfRGBA12;
3611   fglInternalFormat := GL_RGBA12;
3612 end;
3613
3614 constructor TfdBGRA16.Create;
3615 begin
3616   inherited Create;
3617   fFormat           := tfBGRA16;
3618   fWithAlpha        := tfBGRA16;
3619   fWithoutAlpha     := tfBGR16;
3620   fRGBInverted      := tfRGBA16;
3621   fglInternalFormat := GL_RGBA16;
3622 end;
3623
3624 constructor TfdDepth16.Create;
3625 begin
3626   inherited Create;
3627   fFormat           := tfDepth16;
3628   fWithAlpha        := tfEmpty;
3629   fWithoutAlpha     := tfDepth16;
3630   fglInternalFormat := GL_DEPTH_COMPONENT16;
3631 end;
3632
3633 constructor TfdDepth24.Create;
3634 begin
3635   inherited Create;
3636   fFormat           := tfDepth24;
3637   fWithAlpha        := tfEmpty;
3638   fWithoutAlpha     := tfDepth24;
3639   fglInternalFormat := GL_DEPTH_COMPONENT24;
3640 end;
3641
3642 constructor TfdDepth32.Create;
3643 begin
3644   inherited Create;
3645   fFormat           := tfDepth32;
3646   fWithAlpha        := tfEmpty;
3647   fWithoutAlpha     := tfDepth32;
3648   fglInternalFormat := GL_DEPTH_COMPONENT32;
3649 end;
3650
3651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3652 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3654 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3655 begin
3656   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3657 end;
3658
3659 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3660 begin
3661   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3662 end;
3663
3664 constructor TfdS3tcDtx1RGBA.Create;
3665 begin
3666   inherited Create;
3667   fFormat           := tfS3tcDtx1RGBA;
3668   fWithAlpha        := tfS3tcDtx1RGBA;
3669   fUncompressed     := tfRGB5A1;
3670   fPixelSize        := 0.5;
3671   fIsCompressed     := true;
3672   fglFormat         := GL_COMPRESSED_RGBA;
3673   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3674   fglDataFormat     := GL_UNSIGNED_BYTE;
3675 end;
3676
3677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3678 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3680 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3681 begin
3682   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3683 end;
3684
3685 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3686 begin
3687   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3688 end;
3689
3690 constructor TfdS3tcDtx3RGBA.Create;
3691 begin
3692   inherited Create;
3693   fFormat           := tfS3tcDtx3RGBA;
3694   fWithAlpha        := tfS3tcDtx3RGBA;
3695   fUncompressed     := tfRGBA8;
3696   fPixelSize        := 1.0;
3697   fIsCompressed     := true;
3698   fglFormat         := GL_COMPRESSED_RGBA;
3699   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3700   fglDataFormat     := GL_UNSIGNED_BYTE;
3701 end;
3702
3703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3704 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3706 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3707 begin
3708   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3709 end;
3710
3711 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3712 begin
3713   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3714 end;
3715
3716 constructor TfdS3tcDtx5RGBA.Create;
3717 begin
3718   inherited Create;
3719   fFormat           := tfS3tcDtx3RGBA;
3720   fWithAlpha        := tfS3tcDtx3RGBA;
3721   fUncompressed     := tfRGBA8;
3722   fPixelSize        := 1.0;
3723   fIsCompressed     := true;
3724   fglFormat         := GL_COMPRESSED_RGBA;
3725   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3726   fglDataFormat     := GL_UNSIGNED_BYTE;
3727 end;
3728
3729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3730 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3732 class procedure TFormatDescriptor.Init;
3733 begin
3734   if not Assigned(FormatDescriptorCS) then
3735     FormatDescriptorCS := TCriticalSection.Create;
3736 end;
3737
3738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3739 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3740 begin
3741   FormatDescriptorCS.Enter;
3742   try
3743     result := FormatDescriptors[aFormat];
3744     if not Assigned(result) then begin
3745       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3746       FormatDescriptors[aFormat] := result;
3747     end;
3748   finally
3749     FormatDescriptorCS.Leave;
3750   end;
3751 end;
3752
3753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3754 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3755 begin
3756   result := Get(Get(aFormat).WithAlpha);
3757 end;
3758
3759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3760 class procedure TFormatDescriptor.Clear;
3761 var
3762   f: TglBitmapFormat;
3763 begin
3764   FormatDescriptorCS.Enter;
3765   try
3766     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3767       FreeAndNil(FormatDescriptors[f]);
3768   finally
3769     FormatDescriptorCS.Leave;
3770   end;
3771 end;
3772
3773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3774 class procedure TFormatDescriptor.Finalize;
3775 begin
3776   Clear;
3777   FreeAndNil(FormatDescriptorCS);
3778 end;
3779
3780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3781 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3783 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3784 begin
3785   Update(aValue, fRange.r, fShift.r);
3786 end;
3787
3788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3789 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3790 begin
3791   Update(aValue, fRange.g, fShift.g);
3792 end;
3793
3794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3795 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3796 begin
3797   Update(aValue, fRange.b, fShift.b);
3798 end;
3799
3800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3801 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3802 begin
3803   Update(aValue, fRange.a, fShift.a);
3804 end;
3805
3806 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3807 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3808   aShift: Byte);
3809 begin
3810   aShift := 0;
3811   aRange := 0;
3812   if (aMask = 0) then
3813     exit;
3814   while (aMask > 0) and ((aMask and 1) = 0) do begin
3815     inc(aShift);
3816     aMask := aMask shr 1;
3817   end;
3818   aRange := 1;
3819   while (aMask > 0) do begin
3820     aRange := aRange shl 1;
3821     aMask  := aMask  shr 1;
3822   end;
3823   dec(aRange);
3824
3825   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3826 end;
3827
3828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3829 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3830 var
3831   data: QWord;
3832   s: Integer;
3833 begin
3834   data :=
3835     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3836     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3837     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3838     ((aPixel.Data.a and fRange.a) shl fShift.a);
3839   s := Round(fPixelSize);
3840   case s of
3841     1:           aData^  := data;
3842     2:     PWord(aData)^ := data;
3843     4: PCardinal(aData)^ := data;
3844     8:    PQWord(aData)^ := data;
3845   else
3846     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3847   end;
3848   inc(aData, s);
3849 end;
3850
3851 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3852 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3853 var
3854   data: QWord;
3855   s, i: Integer;
3856 begin
3857   s := Round(fPixelSize);
3858   case s of
3859     1: data :=           aData^;
3860     2: data :=     PWord(aData)^;
3861     4: data := PCardinal(aData)^;
3862     8: data :=    PQWord(aData)^;
3863   else
3864     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3865   end;
3866   for i := 0 to 3 do
3867     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3868   inc(aData, s);
3869 end;
3870
3871 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3872 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3874 procedure TbmpColorTableFormat.CreateColorTable;
3875 var
3876   i: Integer;
3877 begin
3878   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3879     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3880
3881   if (Format = tfLuminance4) then
3882     SetLength(fColorTable, 16)
3883   else
3884     SetLength(fColorTable, 256);
3885
3886   case Format of
3887     tfLuminance4: begin
3888       for i := 0 to High(fColorTable) do begin
3889         fColorTable[i].r := 16 * i;
3890         fColorTable[i].g := 16 * i;
3891         fColorTable[i].b := 16 * i;
3892         fColorTable[i].a := 0;
3893       end;
3894     end;
3895
3896     tfLuminance8: begin
3897       for i := 0 to High(fColorTable) do begin
3898         fColorTable[i].r := i;
3899         fColorTable[i].g := i;
3900         fColorTable[i].b := i;
3901         fColorTable[i].a := 0;
3902       end;
3903     end;
3904
3905     tfR3G3B2: begin
3906       for i := 0 to High(fColorTable) do begin
3907         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3908         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3909         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3910         fColorTable[i].a := 0;
3911       end;
3912     end;
3913   end;
3914 end;
3915
3916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3917 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3918 var
3919   d: Byte;
3920 begin
3921   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3922     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3923
3924   case Format of
3925     tfLuminance4: begin
3926       if (aMapData = nil) then
3927         aData^ := 0;
3928       d := LuminanceWeight(aPixel) and Range.r;
3929       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3930       inc(aMapData, 4);
3931       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3932         inc(aData);
3933         aMapData := nil;
3934       end;
3935     end;
3936
3937     tfLuminance8: begin
3938       aData^ := LuminanceWeight(aPixel) and Range.r;
3939       inc(aData);
3940     end;
3941
3942     tfR3G3B2: begin
3943       aData^ := Round(
3944         ((aPixel.Data.r and Range.r) shl Shift.r) or
3945         ((aPixel.Data.g and Range.g) shl Shift.g) or
3946         ((aPixel.Data.b and Range.b) shl Shift.b));
3947       inc(aData);
3948     end;
3949   end;
3950 end;
3951
3952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3953 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3954 var
3955   idx: QWord;
3956   s: Integer;
3957   bits: Byte;
3958   f: Single;
3959 begin
3960   s    := Trunc(fPixelSize);
3961   f    := fPixelSize - s;
3962   bits := Round(8 * f);
3963   case s of
3964     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
3965     1: idx :=           aData^;
3966     2: idx :=     PWord(aData)^;
3967     4: idx := PCardinal(aData)^;
3968     8: idx :=    PQWord(aData)^;
3969   else
3970     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3971   end;
3972   if (idx >= Length(fColorTable)) then
3973     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3974   with fColorTable[idx] do begin
3975     aPixel.Data.r := r;
3976     aPixel.Data.g := g;
3977     aPixel.Data.b := b;
3978     aPixel.Data.a := a;
3979   end;
3980   inc(aMapData, bits);
3981   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3982     inc(aData, 1);
3983     dec(aMapData, 8);
3984   end;
3985   inc(aData, s);
3986 end;
3987
3988 destructor TbmpColorTableFormat.Destroy;
3989 begin
3990   SetLength(fColorTable, 0);
3991   inherited Destroy;
3992 end;
3993
3994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3995 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3997 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3998 var
3999   i: Integer;
4000 begin
4001   for i := 0 to 3 do begin
4002     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4003       if (aSourceFD.Range.arr[i] > 0) then
4004         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4005       else
4006         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4007     end;
4008   end;
4009 end;
4010
4011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4012 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4013 begin
4014   with aFuncRec do begin
4015     if (Source.Range.r   > 0) then
4016       Dest.Data.r := Source.Data.r;
4017     if (Source.Range.g > 0) then
4018       Dest.Data.g := Source.Data.g;
4019     if (Source.Range.b  > 0) then
4020       Dest.Data.b := Source.Data.b;
4021     if (Source.Range.a > 0) then
4022       Dest.Data.a := Source.Data.a;
4023   end;
4024 end;
4025
4026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4027 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4028 var
4029   i: Integer;
4030 begin
4031   with aFuncRec do begin
4032     for i := 0 to 3 do
4033       if (Source.Range.arr[i] > 0) then
4034         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4035   end;
4036 end;
4037
4038 type
4039   TShiftData = packed record
4040     case Integer of
4041       0: (r, g, b, a: SmallInt);
4042       1: (arr: array[0..3] of SmallInt);
4043   end;
4044   PShiftData = ^TShiftData;
4045
4046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4047 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4048 var
4049   i: Integer;
4050 begin
4051   with aFuncRec do
4052     for i := 0 to 3 do
4053       if (Source.Range.arr[i] > 0) then
4054         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4055 end;
4056
4057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4058 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4059 begin
4060   with aFuncRec do begin
4061     Dest.Data := Source.Data;
4062     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4063       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4064       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4065       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4066     end;
4067     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4068       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4069     end;
4070   end;
4071 end;
4072
4073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4074 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4075 var
4076   i: Integer;
4077 begin
4078   with aFuncRec do begin
4079     for i := 0 to 3 do
4080       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4081   end;
4082 end;
4083
4084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4085 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4086 var
4087   Temp: Single;
4088 begin
4089   with FuncRec do begin
4090     if (FuncRec.Args = nil) then begin //source has no alpha
4091       Temp :=
4092         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4093         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4094         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4095       Dest.Data.a := Round(Dest.Range.a * Temp);
4096     end else
4097       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4098   end;
4099 end;
4100
4101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4102 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4103 type
4104   PglBitmapPixelData = ^TglBitmapPixelData;
4105 begin
4106   with FuncRec do begin
4107     Dest.Data.r := Source.Data.r;
4108     Dest.Data.g := Source.Data.g;
4109     Dest.Data.b := Source.Data.b;
4110
4111     with PglBitmapPixelData(Args)^ do
4112       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4113           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4114           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4115         Dest.Data.a := 0
4116       else
4117         Dest.Data.a := Dest.Range.a;
4118   end;
4119 end;
4120
4121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4123 begin
4124   with FuncRec do begin
4125     Dest.Data.r := Source.Data.r;
4126     Dest.Data.g := Source.Data.g;
4127     Dest.Data.b := Source.Data.b;
4128     Dest.Data.a := PCardinal(Args)^;
4129   end;
4130 end;
4131
4132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4133 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4134 type
4135   PRGBPix = ^TRGBPix;
4136   TRGBPix = array [0..2] of byte;
4137 var
4138   Temp: Byte;
4139 begin
4140   while aWidth > 0 do begin
4141     Temp := PRGBPix(aData)^[0];
4142     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4143     PRGBPix(aData)^[2] := Temp;
4144
4145     if aHasAlpha then
4146       Inc(aData, 4)
4147     else
4148       Inc(aData, 3);
4149     dec(aWidth);
4150   end;
4151 end;
4152
4153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4154 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4156 function TglBitmap.GetWidth: Integer;
4157 begin
4158   if (ffX in fDimension.Fields) then
4159     result := fDimension.X
4160   else
4161     result := -1;
4162 end;
4163
4164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 function TglBitmap.GetHeight: Integer;
4166 begin
4167   if (ffY in fDimension.Fields) then
4168     result := fDimension.Y
4169   else
4170     result := -1;
4171 end;
4172
4173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4174 function TglBitmap.GetFileWidth: Integer;
4175 begin
4176   result := Max(1, Width);
4177 end;
4178
4179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4180 function TglBitmap.GetFileHeight: Integer;
4181 begin
4182   result := Max(1, Height);
4183 end;
4184
4185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4186 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4187 begin
4188   if fCustomData = aValue then
4189     exit;
4190   fCustomData := aValue;
4191 end;
4192
4193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4194 procedure TglBitmap.SetCustomName(const aValue: String);
4195 begin
4196   if fCustomName = aValue then
4197     exit;
4198   fCustomName := aValue;
4199 end;
4200
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4203 begin
4204   if fCustomNameW = aValue then
4205     exit;
4206   fCustomNameW := aValue;
4207 end;
4208
4209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4210 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4211 begin
4212   if fDeleteTextureOnFree = aValue then
4213     exit;
4214   fDeleteTextureOnFree := aValue;
4215 end;
4216
4217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4218 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4219 begin
4220   if fFormat = aValue then
4221     exit;
4222   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4223     raise EglBitmapUnsupportedFormat.Create('SetFormat');
4224   SetDataPointer(Data, aValue, Width, Height);
4225 end;
4226
4227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4228 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4229 begin
4230   if fFreeDataAfterGenTexture = aValue then
4231     exit;
4232   fFreeDataAfterGenTexture := aValue;
4233 end;
4234
4235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4236 procedure TglBitmap.SetID(const aValue: Cardinal);
4237 begin
4238   if fID = aValue then
4239     exit;
4240   fID := aValue;
4241 end;
4242
4243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4244 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4245 begin
4246   if fMipMap = aValue then
4247     exit;
4248   fMipMap := aValue;
4249 end;
4250
4251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4252 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4253 begin
4254   if fTarget = aValue then
4255     exit;
4256   fTarget := aValue;
4257 end;
4258
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4261 var
4262   MaxAnisotropic: Integer;
4263 begin
4264   fAnisotropic := aValue;
4265   if (ID > 0) then begin
4266     if GL_EXT_texture_filter_anisotropic then begin
4267       if fAnisotropic > 0 then begin
4268         Bind(false);
4269         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4270         if aValue > MaxAnisotropic then
4271           fAnisotropic := MaxAnisotropic;
4272         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4273       end;
4274     end else begin
4275       fAnisotropic := 0;
4276     end;
4277   end;
4278 end;
4279
4280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4281 procedure TglBitmap.CreateID;
4282 begin
4283   if (ID <> 0) then
4284     glDeleteTextures(1, @fID);
4285   glGenTextures(1, @fID);
4286   Bind(false);
4287 end;
4288
4289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4290 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4291 begin
4292   // Set Up Parameters
4293   SetWrap(fWrapS, fWrapT, fWrapR);
4294   SetFilter(fFilterMin, fFilterMag);
4295   SetAnisotropic(fAnisotropic);
4296   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4297
4298   // Mip Maps Generation Mode
4299   aBuildWithGlu := false;
4300   if (MipMap = mmMipmap) then begin
4301     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4302       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4303     else
4304       aBuildWithGlu := true;
4305   end else if (MipMap = mmMipmapGlu) then
4306     aBuildWithGlu := true;
4307 end;
4308
4309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4310 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4311   const aWidth: Integer; const aHeight: Integer);
4312 var
4313   s: Single;
4314 begin
4315   if (Data <> aData) then begin
4316     if (Assigned(Data)) then
4317       FreeMem(Data);
4318     fData := aData;
4319   end;
4320
4321   FillChar(fDimension, SizeOf(fDimension), 0);
4322   if not Assigned(fData) then begin
4323     fFormat    := tfEmpty;
4324     fPixelSize := 0;
4325     fRowSize   := 0;
4326   end else begin
4327     if aWidth <> -1 then begin
4328       fDimension.Fields := fDimension.Fields + [ffX];
4329       fDimension.X := aWidth;
4330     end;
4331
4332     if aHeight <> -1 then begin
4333       fDimension.Fields := fDimension.Fields + [ffY];
4334       fDimension.Y := aHeight;
4335     end;
4336
4337     s := TFormatDescriptor.Get(aFormat).PixelSize;
4338     fFormat    := aFormat;
4339     fPixelSize := Ceil(s);
4340     fRowSize   := Ceil(s * aWidth);
4341   end;
4342 end;
4343
4344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4345 function TglBitmap.FlipHorz: Boolean;
4346 begin
4347   result := false;
4348 end;
4349
4350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4351 function TglBitmap.FlipVert: Boolean;
4352 begin
4353   result := false;
4354 end;
4355
4356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4357 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4359 procedure TglBitmap.AfterConstruction;
4360 begin
4361   inherited AfterConstruction;
4362
4363   fID         := 0;
4364   fTarget     := 0;
4365   fIsResident := false;
4366
4367   fFormat                  := glBitmapGetDefaultFormat;
4368   fMipMap                  := glBitmapDefaultMipmap;
4369   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4370   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4371
4372   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4373   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 procedure TglBitmap.BeforeDestruction;
4378 begin
4379   SetDataPointer(nil, tfEmpty);
4380   if (fID > 0) and fDeleteTextureOnFree then
4381     glDeleteTextures(1, @fID);
4382   inherited BeforeDestruction;
4383 end;
4384
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 procedure TglBitmap.LoadFromFile(const aFilename: String);
4387 var
4388   fs: TFileStream;
4389 begin
4390   if not FileExists(aFilename) then
4391     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4392   fFilename := aFilename;
4393   fs := TFileStream.Create(fFilename, fmOpenRead);
4394   try
4395     fs.Position := 0;
4396     LoadFromStream(fs);
4397   finally
4398     fs.Free;
4399   end;
4400 end;
4401
4402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4403 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4404 begin
4405   {$IFDEF GLB_SUPPORT_PNG_READ}
4406   if not LoadPNG(aStream) then
4407   {$ENDIF}
4408   {$IFDEF GLB_SUPPORT_JPEG_READ}
4409   if not LoadJPEG(aStream) then
4410   {$ENDIF}
4411   if not LoadDDS(aStream) then
4412   if not LoadTGA(aStream) then
4413   if not LoadBMP(aStream) then
4414     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4415 end;
4416
4417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4418 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4419   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4420 var
4421   tmpData: PByte;
4422   size: Integer;
4423 begin
4424   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4425   GetMem(tmpData, size);
4426   try
4427     FillChar(tmpData^, size, #$FF);
4428     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4429   except
4430     FreeMem(tmpData);
4431     raise;
4432   end;
4433   AddFunc(Self, aFunc, false, Format, aArgs);
4434 end;
4435
4436 {$IFDEF GLB_DELPHI}
4437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4438 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
4439 var
4440   rs: TResourceStream;
4441   TempPos: Integer;
4442   ResTypeStr: String;
4443   TempResType: PChar;
4444 begin
4445   if not Assigned(ResType) then begin
4446     TempPos     := Pos('.', Resource);
4447     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4448     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));
4449     TempResType := PChar(ResTypeStr);
4450   end else
4451     TempResType := ResType
4452
4453   rs := TResourceStream.Create(Instance, Resource, TempResType);
4454   try
4455     LoadFromStream(rs);
4456   finally
4457     rs.Free;
4458   end;
4459 end;
4460
4461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4462 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4463 var
4464   rs: TResourceStream;
4465 begin
4466   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4467   try
4468     LoadFromStream(rs);
4469   finally
4470     rs.Free;
4471   end;
4472 end;
4473 {$ENDIF}
4474
4475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4476 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4477 var
4478   fs: TFileStream;
4479 begin
4480   fs := TFileStream.Create(aFileName, fmCreate);
4481   try
4482     fs.Position := 0;
4483     SaveToStream(fs, aFileType);
4484   finally
4485     fs.Free;
4486   end;
4487 end;
4488
4489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4490 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4491 begin
4492   case aFileType of
4493     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4494     ftPNG:  SavePng(aStream);
4495     {$ENDIF}
4496     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4497     ftJPEG: SaveJPEG(aStream);
4498     {$ENDIF}
4499     ftDDS:  SaveDDS(aStream);
4500     ftTGA:  SaveTGA(aStream);
4501     ftBMP:  SaveBMP(aStream);
4502   end;
4503 end;
4504
4505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4506 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4507 begin
4508   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4509 end;
4510
4511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4512 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4513   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4514 var
4515   DestData, TmpData, SourceData: pByte;
4516   TempHeight, TempWidth: Integer;
4517   SourceFD, DestFD: TFormatDescriptor;
4518   SourceMD, DestMD: Pointer;
4519
4520   FuncRec: TglBitmapFunctionRec;
4521 begin
4522   Assert(Assigned(Data));
4523   Assert(Assigned(aSource));
4524   Assert(Assigned(aSource.Data));
4525
4526   result := false;
4527   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4528     SourceFD := TFormatDescriptor.Get(aSource.Format);
4529     DestFD   := TFormatDescriptor.Get(aFormat);
4530
4531     // inkompatible Formats so CreateTemp
4532     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4533       aCreateTemp := true;
4534
4535     // Values
4536     TempHeight := Max(1, aSource.Height);
4537     TempWidth  := Max(1, aSource.Width);
4538
4539     FuncRec.Sender := Self;
4540     FuncRec.Args   := aArgs;
4541
4542     TmpData := nil;
4543     if aCreateTemp then begin
4544       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
4545       DestData := TmpData;
4546     end else
4547       DestData := Data;
4548
4549     try
4550       SourceFD.PreparePixel(FuncRec.Source);
4551       DestFD.PreparePixel  (FuncRec.Dest);
4552
4553       SourceMD := SourceFD.CreateMappingData;
4554       DestMD   := DestFD.CreateMappingData;
4555
4556       FuncRec.Size            := aSource.Dimension;
4557       FuncRec.Position.Fields := FuncRec.Size.Fields;
4558
4559       try
4560         SourceData := aSource.Data;
4561         FuncRec.Position.Y := 0;
4562         while FuncRec.Position.Y < TempHeight do begin
4563           FuncRec.Position.X := 0;
4564           while FuncRec.Position.X < TempWidth do begin
4565             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4566             aFunc(FuncRec);
4567             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4568             inc(FuncRec.Position.X);
4569           end;
4570           inc(FuncRec.Position.Y);
4571         end;
4572
4573         // Updating Image or InternalFormat
4574         if aCreateTemp then
4575           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4576         else if (aFormat <> fFormat) then
4577           Format := aFormat;
4578
4579         result := true;
4580       finally
4581         SourceFD.FreeMappingData(SourceMD);
4582         DestFD.FreeMappingData(DestMD);
4583       end;
4584     except
4585       if aCreateTemp then
4586         FreeMem(TmpData);
4587       raise;
4588     end;
4589   end;
4590 end;
4591
4592 {$IFDEF GLB_SDL}
4593 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4594 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4595 var
4596   Row, RowSize: Integer;
4597   SourceData, TmpData: PByte;
4598   TempDepth: Integer;
4599   FormatDesc: TFormatDescriptor;
4600
4601   function GetRowPointer(Row: Integer): pByte;
4602   begin
4603     result := aSurface.pixels;
4604     Inc(result, Row * RowSize);
4605   end;
4606
4607 begin
4608   result := false;
4609
4610   FormatDesc := TFormatDescriptor.Get(Format);
4611   if FormatDesc.IsCompressed then
4612     raise EglBitmapUnsupportedFormat.Create('AssignToSurface');
4613
4614   if Assigned(Data) then begin
4615     case Trunc(FormatDesc.PixelSize) of
4616       1: TempDepth :=  8;
4617       2: TempDepth := 16;
4618       3: TempDepth := 24;
4619       4: TempDepth := 32;
4620     else
4621       raise EglBitmapUnsupportedFormat.Create('AssignToSurface');
4622     end;
4623
4624     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4625       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4626     SourceData := Data;
4627     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4628
4629     for Row := 0 to FileHeight-1 do begin
4630       TmpData := GetRowPointer(Row);
4631       if Assigned(TmpData) then begin
4632         Move(SourceData^, TmpData^, RowSize);
4633         inc(SourceData, RowSize);
4634       end;
4635     end;
4636     result := true;
4637   end;
4638 end;
4639
4640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4641 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4642 var
4643   pSource, pData, pTempData: PByte;
4644   Row, RowSize, TempWidth, TempHeight: Integer;
4645   IntFormat: TglBitmapFormat;
4646   FormatDesc: TFormatDescriptor;
4647
4648   function GetRowPointer(Row: Integer): pByte;
4649   begin
4650     result := aSurface^.pixels;
4651     Inc(result, Row * RowSize);
4652   end;
4653
4654 begin
4655   result := false;
4656   if (Assigned(aSurface)) then begin
4657     with aSurface^.format^ do begin
4658       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4659         FormatDesc := TFormatDescriptor.Get(IntFormat);
4660         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4661           break;
4662       end;
4663       if (IntFormat = tfEmpty) then
4664         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4665     end;
4666
4667     TempWidth  := aSurface^.w;
4668     TempHeight := aSurface^.h;
4669     RowSize := FormatDesc.GetSize(TempWidth, 1);
4670     GetMem(pData, TempHeight * RowSize);
4671     try
4672       pTempData := pData;
4673       for Row := 0 to TempHeight -1 do begin
4674         pSource := GetRowPointer(Row);
4675         if (Assigned(pSource)) then begin
4676           Move(pSource^, pTempData^, RowSize);
4677           Inc(pTempData, RowSize);
4678         end;
4679       end;
4680       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4681       result := true;
4682     except
4683       FreeMem(pData);
4684       raise;
4685     end;
4686   end;
4687 end;
4688
4689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4690 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4691 var
4692   Row, Col, AlphaInterleave: Integer;
4693   pSource, pDest: PByte;
4694
4695   function GetRowPointer(Row: Integer): pByte;
4696   begin
4697     result := aSurface.pixels;
4698     Inc(result, Row * Width);
4699   end;
4700
4701 begin
4702   result := false;
4703   if Assigned(Data) then begin
4704     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4705       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4706
4707       AlphaInterleave := 0;
4708       case Format of
4709         tfLuminance8Alpha8:
4710           AlphaInterleave := 1;
4711         tfBGRA8, tfRGBA8:
4712           AlphaInterleave := 3;
4713       end;
4714
4715       pSource := Data;
4716       for Row := 0 to Height -1 do begin
4717         pDest := GetRowPointer(Row);
4718         if Assigned(pDest) then begin
4719           for Col := 0 to Width -1 do begin
4720             Inc(pSource, AlphaInterleave);
4721             pDest^ := pSource^;
4722             Inc(pDest);
4723             Inc(pSource);
4724           end;
4725         end;
4726       end;
4727       result := true;
4728     end;
4729   end;
4730 end;
4731
4732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4733 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4734 var
4735   bmp: TglBitmap2D;
4736 begin
4737   bmp := TglBitmap2D.Create;
4738   try
4739     bmp.AssignFromSurface(aSurface);
4740     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4741   finally
4742     bmp.Free;
4743   end;
4744 end;
4745 {$ENDIF}
4746
4747 {$IFDEF GLB_DELPHI}
4748 //TODO rework & test
4749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4750 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4751 var
4752   Row: Integer;
4753   pSource, pData: PByte;
4754 begin
4755   result := false;
4756   if Assigned(Data) then begin
4757     if Assigned(aBitmap) then begin
4758       aBitmap.Width  := Width;
4759       aBitmap.Height := Height;
4760
4761       case Format of
4762         tfAlpha8, ifLuminance, ifDepth8:
4763           begin
4764             Bitmap.PixelFormat := pf8bit;
4765             Bitmap.Palette := CreateGrayPalette;
4766           end;
4767         ifRGB5A1:
4768           Bitmap.PixelFormat := pf15bit;
4769         ifR5G6B5:
4770           Bitmap.PixelFormat := pf16bit;
4771         ifRGB8, ifBGR8:
4772           Bitmap.PixelFormat := pf24bit;
4773         ifRGBA8, ifBGRA8:
4774           Bitmap.PixelFormat := pf32bit;
4775         else
4776           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4777       end;
4778
4779       pSource := Data;
4780       for Row := 0 to FileHeight -1 do begin
4781         pData := Bitmap.Scanline[Row];
4782
4783         Move(pSource^, pData^, fRowSize);
4784         Inc(pSource, fRowSize);
4785
4786         // swap RGB(A) to BGR(A)
4787         if InternalFormat in [ifRGB8, ifRGBA8] then
4788           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4789       end;
4790
4791       result := true;
4792     end;
4793   end;
4794 end;
4795
4796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4797 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4798 var
4799   pSource, pData, pTempData: PByte;
4800   Row, RowSize, TempWidth, TempHeight: Integer;
4801   IntFormat: TglBitmapInternalFormat;
4802 begin
4803   result := false;
4804
4805   if (Assigned(Bitmap)) then begin
4806     case Bitmap.PixelFormat of
4807       pf8bit:
4808         IntFormat := ifLuminance;
4809       pf15bit:
4810         IntFormat := ifRGB5A1;
4811       pf16bit:
4812         IntFormat := ifR5G6B5;
4813       pf24bit:
4814         IntFormat := ifBGR8;
4815       pf32bit:
4816         IntFormat := ifBGRA8;
4817       else
4818         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4819     end;
4820
4821     TempWidth := Bitmap.Width;
4822     TempHeight := Bitmap.Height;
4823
4824     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4825
4826     GetMem(pData, TempHeight * RowSize);
4827     try
4828       pTempData := pData;
4829
4830       for Row := 0 to TempHeight -1 do begin
4831         pSource := Bitmap.Scanline[Row];
4832
4833         if (Assigned(pSource)) then begin
4834           Move(pSource^, pTempData^, RowSize);
4835           Inc(pTempData, RowSize);
4836         end;
4837       end;
4838
4839       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4840
4841       result := true;
4842     except
4843       FreeMem(pData);
4844       raise;
4845     end;
4846   end;
4847 end;
4848
4849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4850 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4851 var
4852   Row, Col, AlphaInterleave: Integer;
4853   pSource, pDest: PByte;
4854 begin
4855   result := false;
4856
4857   if Assigned(Data) then begin
4858     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4859       if Assigned(Bitmap) then begin
4860         Bitmap.PixelFormat := pf8bit;
4861         Bitmap.Palette := CreateGrayPalette;
4862         Bitmap.Width := Width;
4863         Bitmap.Height := Height;
4864
4865         case InternalFormat of
4866           ifLuminanceAlpha:
4867             AlphaInterleave := 1;
4868           ifRGBA8, ifBGRA8:
4869             AlphaInterleave := 3;
4870           else
4871             AlphaInterleave := 0;
4872         end;
4873
4874         // Copy Data
4875         pSource := Data;
4876
4877         for Row := 0 to Height -1 do begin
4878           pDest := Bitmap.Scanline[Row];
4879
4880           if Assigned(pDest) then begin
4881             for Col := 0 to Width -1 do begin
4882               Inc(pSource, AlphaInterleave);
4883               pDest^ := pSource^;
4884               Inc(pDest);
4885               Inc(pSource);
4886             end;
4887           end;
4888         end;
4889
4890         result := true;
4891       end;
4892     end;
4893   end;
4894 end;
4895
4896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4897 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4898 var
4899   tex: TglBitmap2D;
4900 begin
4901   tex := TglBitmap2D.Create;
4902   try
4903     tex.AssignFromBitmap(Bitmap);
4904     result := AddAlphaFromglBitmap(tex, Func, CustomData);
4905   finally
4906     tex.Free;
4907   end;
4908 end;
4909
4910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4911 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
4912   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4913 var
4914   RS: TResourceStream;
4915   TempPos: Integer;
4916   ResTypeStr: String;
4917   TempResType: PChar;
4918 begin
4919   if Assigned(ResType) then
4920     TempResType := ResType
4921   else
4922     begin
4923       TempPos := Pos('.', Resource);
4924       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4925       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
4926       TempResType := PChar(ResTypeStr);
4927     end;
4928
4929   RS := TResourceStream.Create(Instance, Resource, TempResType);
4930   try
4931     result := AddAlphaFromStream(RS, Func, CustomData);
4932   finally
4933     RS.Free;
4934   end;
4935 end;
4936
4937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4938 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4939   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4940 var
4941   RS: TResourceStream;
4942 begin
4943   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4944   try
4945     result := AddAlphaFromStream(RS, Func, CustomData);
4946   finally
4947     RS.Free;
4948   end;
4949 end;
4950 {$ENDIF}
4951
4952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4953 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4954 begin
4955   (* TODO
4956   if not FormatIsUncompressed(InternalFormat) then
4957     raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
4958   *)
4959   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4960 end;
4961
4962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4963 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4964 var
4965   FS: TFileStream;
4966 begin
4967   FS := TFileStream.Create(FileName, fmOpenRead);
4968   try
4969     result := AddAlphaFromStream(FS, aFunc, aArgs);
4970   finally
4971     FS.Free;
4972   end;
4973 end;
4974
4975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4976 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4977 var
4978   tex: TglBitmap2D;
4979 begin
4980   tex := TglBitmap2D.Create(aStream);
4981   try
4982     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4983   finally
4984     tex.Free;
4985   end;
4986 end;
4987
4988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4989 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4990 var
4991   DestData, DestData2, SourceData: pByte;
4992   TempHeight, TempWidth: Integer;
4993   SourceFD, DestFD: TFormatDescriptor;
4994   SourceMD, DestMD, DestMD2: Pointer;
4995
4996   FuncRec: TglBitmapFunctionRec;
4997 begin
4998   result := false;
4999
5000   Assert(Assigned(Data));
5001   Assert(Assigned(aBitmap));
5002   Assert(Assigned(aBitmap.Data));
5003
5004   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5005     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5006
5007     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5008     DestFD   := TFormatDescriptor.Get(Format);
5009
5010     if not Assigned(aFunc) then begin
5011       aFunc        := glBitmapAlphaFunc;
5012       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5013     end else
5014       FuncRec.Args := aArgs;
5015
5016     // Values
5017     TempHeight := aBitmap.FileHeight;
5018     TempWidth  := aBitmap.FileWidth;
5019
5020     FuncRec.Sender          := Self;
5021     FuncRec.Size            := Dimension;
5022     FuncRec.Position.Fields := FuncRec.Size.Fields;
5023
5024     DestData   := Data;
5025     DestData2  := Data;
5026     SourceData := aBitmap.Data;
5027
5028     // Mapping
5029     SourceFD.PreparePixel(FuncRec.Source);
5030     DestFD.PreparePixel  (FuncRec.Dest);
5031
5032     SourceMD := SourceFD.CreateMappingData;
5033     DestMD   := DestFD.CreateMappingData;
5034     DestMD2  := DestFD.CreateMappingData;
5035     try
5036       FuncRec.Position.Y := 0;
5037       while FuncRec.Position.Y < TempHeight do begin
5038         FuncRec.Position.X := 0;
5039         while FuncRec.Position.X < TempWidth do begin
5040           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5041           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5042           aFunc(FuncRec);
5043           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5044           inc(FuncRec.Position.X);
5045         end;
5046         inc(FuncRec.Position.Y);
5047       end;
5048     finally
5049       SourceFD.FreeMappingData(SourceMD);
5050       DestFD.FreeMappingData(DestMD);
5051       DestFD.FreeMappingData(DestMD2);
5052     end;
5053   end;
5054 end;
5055
5056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5057 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5058 begin
5059   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5060 end;
5061
5062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5063 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5064 var
5065   PixelData: TglBitmapPixelData;
5066 begin
5067   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5068   result := AddAlphaFromColorKeyFloat(
5069     aRed   / PixelData.Range.r,
5070     aGreen / PixelData.Range.g,
5071     aBlue  / PixelData.Range.b,
5072     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5073 end;
5074
5075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5076 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5077 var
5078   values: array[0..2] of Single;
5079   tmp: Cardinal;
5080   i: Integer;
5081   PixelData: TglBitmapPixelData;
5082 begin
5083   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5084   with PixelData do begin
5085     values[0] := aRed;
5086     values[1] := aGreen;
5087     values[2] := aBlue;
5088
5089     for i := 0 to 2 do begin
5090       tmp          := Trunc(Range.arr[i] * aDeviation);
5091       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5092       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5093     end;
5094     Data.a  := 0;
5095     Range.a := 0;
5096   end;
5097   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5098 end;
5099
5100 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5101 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5102 begin
5103   result := AddAlphaFromValueFloat(aAlpha / $FF);
5104 end;
5105
5106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5107 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5108 var
5109   PixelData: TglBitmapPixelData;
5110 begin
5111   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5112   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5113 end;
5114
5115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5116 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5117 var
5118   PixelData: TglBitmapPixelData;
5119 begin
5120   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5121   with PixelData do
5122     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5123   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5124 end;
5125
5126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5127 function TglBitmap.RemoveAlpha: Boolean;
5128 var
5129   FormatDesc: TFormatDescriptor;
5130 begin
5131   result := false;
5132   FormatDesc := TFormatDescriptor.Get(Format);
5133   if Assigned(Data) then begin
5134     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5135       raise EglBitmapUnsupportedFormat.Create('RemoveAlpha');
5136     result := ConvertTo(FormatDesc.WithoutAlpha);
5137   end;
5138 end;
5139
5140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5141 function TglBitmap.Clone: TglBitmap;
5142 var
5143   Temp: TglBitmap;
5144   TempPtr: PByte;
5145   Size: Integer;
5146 begin
5147   result := nil;
5148   Temp := (ClassType.Create as TglBitmap);
5149   try
5150     // copy texture data if assigned
5151     if Assigned(Data) then begin
5152       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5153       GetMem(TempPtr, Size);
5154       try
5155         Move(Data^, TempPtr^, Size);
5156         Temp.SetDataPointer(TempPtr, Format, Width, Height);
5157       except
5158         FreeMem(TempPtr);
5159         raise;
5160       end;
5161     end else
5162       Temp.SetDataPointer(nil, Format, Width, Height);
5163
5164         // copy properties
5165     Temp.fID                      := ID;
5166     Temp.fTarget                  := Target;
5167     Temp.fFormat                  := Format;
5168     Temp.fMipMap                  := MipMap;
5169     Temp.fAnisotropic             := Anisotropic;
5170     Temp.fBorderColor             := fBorderColor;
5171     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5172     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5173     Temp.fFilterMin               := fFilterMin;
5174     Temp.fFilterMag               := fFilterMag;
5175     Temp.fWrapS                   := fWrapS;
5176     Temp.fWrapT                   := fWrapT;
5177     Temp.fWrapR                   := fWrapR;
5178     Temp.fFilename                := fFilename;
5179     Temp.fCustomName              := fCustomName;
5180     Temp.fCustomNameW             := fCustomNameW;
5181     Temp.fCustomData              := fCustomData;
5182
5183     result := Temp;
5184   except
5185     FreeAndNil(Temp);
5186     raise;
5187   end;
5188 end;
5189
5190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5191 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5192 var
5193   SourceFD, DestFD: TFormatDescriptor;
5194   SourcePD, DestPD: TglBitmapPixelData;
5195   ShiftData: TShiftData;
5196
5197   function CanCopyDirect: Boolean;
5198   begin
5199     result :=
5200       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5201       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5202       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5203       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5204   end;
5205
5206   function CanShift: Boolean;
5207   begin
5208     result :=
5209       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5210       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5211       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5212       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5213   end;
5214
5215   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5216   begin
5217     result := 0;
5218     while (aSource > aDest) and (aSource > 0) do begin
5219       inc(result);
5220       aSource := aSource shr 1;
5221     end;
5222   end;
5223
5224 begin
5225   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5226     SourceFD := TFormatDescriptor.Get(Format);
5227     DestFD   := TFormatDescriptor.Get(aFormat);
5228
5229     SourceFD.PreparePixel(SourcePD);
5230     DestFD.PreparePixel  (DestPD);
5231
5232     if CanCopyDirect then
5233       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5234     else if CanShift then begin
5235       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5236       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5237       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5238       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5239       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5240     end else
5241       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5242   end else
5243     result := true;
5244 end;
5245
5246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5247 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5248 begin
5249   if aUseRGB or aUseAlpha then
5250     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5251       ((PtrInt(aUseAlpha) and 1) shl 1) or
5252        (PtrInt(aUseRGB)   and 1)      ));
5253 end;
5254
5255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5256 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5257 begin
5258   fBorderColor[0] := aRed;
5259   fBorderColor[1] := aGreen;
5260   fBorderColor[2] := aBlue;
5261   fBorderColor[3] := aAlpha;
5262   if (ID > 0) then begin
5263     Bind(false);
5264     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5265   end;
5266 end;
5267
5268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5269 procedure TglBitmap.FreeData;
5270 begin
5271   SetDataPointer(nil, tfEmpty);
5272 end;
5273
5274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5275 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5276   const aAlpha: Byte);
5277 begin
5278   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5279 end;
5280
5281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5282 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5283 var
5284   PixelData: TglBitmapPixelData;
5285 begin
5286   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5287   FillWithColorFloat(
5288     aRed   / PixelData.Range.r,
5289     aGreen / PixelData.Range.g,
5290     aBlue  / PixelData.Range.b,
5291     aAlpha / PixelData.Range.a);
5292 end;
5293
5294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5295 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5296 var
5297   PixelData: TglBitmapPixelData;
5298 begin
5299   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5300   with PixelData do begin
5301     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5302     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5303     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5304     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5305   end;
5306   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5307 end;
5308
5309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5310 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5311 begin
5312   //check MIN filter
5313   case aMin of
5314     GL_NEAREST:
5315       fFilterMin := GL_NEAREST;
5316     GL_LINEAR:
5317       fFilterMin := GL_LINEAR;
5318     GL_NEAREST_MIPMAP_NEAREST:
5319       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5320     GL_LINEAR_MIPMAP_NEAREST:
5321       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5322     GL_NEAREST_MIPMAP_LINEAR:
5323       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5324     GL_LINEAR_MIPMAP_LINEAR:
5325       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5326     else
5327       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5328   end;
5329
5330   //check MAG filter
5331   case aMag of
5332     GL_NEAREST:
5333       fFilterMag := GL_NEAREST;
5334     GL_LINEAR:
5335       fFilterMag := GL_LINEAR;
5336     else
5337       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5338   end;
5339
5340   //apply filter
5341   if (ID > 0) then begin
5342     Bind(false);
5343     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5344
5345     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5346       case fFilterMin of
5347         GL_NEAREST, GL_LINEAR:
5348           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5349         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5350           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5351         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5352           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5353       end;
5354     end else
5355       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5356   end;
5357 end;
5358
5359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5360 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5361
5362   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5363   begin
5364     case aValue of
5365       GL_CLAMP:
5366         aTarget := GL_CLAMP;
5367
5368       GL_REPEAT:
5369         aTarget := GL_REPEAT;
5370
5371       GL_CLAMP_TO_EDGE: begin
5372         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5373           aTarget := GL_CLAMP_TO_EDGE
5374         else
5375           aTarget := GL_CLAMP;
5376       end;
5377
5378       GL_CLAMP_TO_BORDER: begin
5379         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5380           aTarget := GL_CLAMP_TO_BORDER
5381         else
5382           aTarget := GL_CLAMP;
5383       end;
5384
5385       GL_MIRRORED_REPEAT: begin
5386         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5387           aTarget := GL_MIRRORED_REPEAT
5388         else
5389           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5390       end;
5391     else
5392       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5393     end;
5394   end;
5395
5396 begin
5397   CheckAndSetWrap(S, fWrapS);
5398   CheckAndSetWrap(T, fWrapT);
5399   CheckAndSetWrap(R, fWrapR);
5400
5401   if (ID > 0) then begin
5402     Bind(false);
5403     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5404     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5405     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5406   end;
5407 end;
5408
5409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5410 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5411 begin
5412   if aEnableTextureUnit then
5413     glEnable(Target);
5414   if (ID > 0) then
5415     glBindTexture(Target, ID);
5416 end;
5417
5418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5419 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5420 begin
5421   if aDisableTextureUnit then
5422     glDisable(Target);
5423   glBindTexture(Target, 0);
5424 end;
5425
5426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5427 constructor TglBitmap.Create;
5428 begin
5429 {$IFDEF GLB_NATIVE_OGL}
5430   glbReadOpenGLExtensions;
5431 {$ENDIF}
5432   if (ClassType = TglBitmap) then
5433     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5434   inherited Create;
5435 end;
5436
5437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5438 constructor TglBitmap.Create(const aFileName: String);
5439 begin
5440   Create;
5441   LoadFromFile(FileName);
5442 end;
5443
5444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5445 constructor TglBitmap.Create(const aStream: TStream);
5446 begin
5447   Create;
5448   LoadFromStream(aStream);
5449 end;
5450
5451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5452 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5453 var
5454   Image: PByte;
5455   ImageSize: Integer;
5456 begin
5457   Create;
5458   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5459   GetMem(Image, ImageSize);
5460   try
5461     FillChar(Image^, ImageSize, #$FF);
5462     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5463   except
5464     FreeMem(Image);
5465     raise;
5466   end;
5467 end;
5468
5469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5470 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5471   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5472 begin
5473   Create;
5474   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5475 end;
5476
5477 {$IFDEF GLB_DELPHI}
5478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5479 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5480 begin
5481   Create;
5482   LoadFromResource(aInstance, aResource, aResType);
5483 end;
5484
5485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5486 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5487 begin
5488   Create;
5489   LoadFromResourceID(aInstance, aResourceID, aResType);
5490 end;
5491 {$ENDIF}
5492
5493 {$IFDEF GLB_SUPPORT_PNG_READ}
5494 {$IF DEFINED(GLB_SDL_IMAGE)}
5495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5496 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5498 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5499 var
5500   Surface: PSDL_Surface;
5501   RWops: PSDL_RWops;
5502 begin
5503   result := false;
5504   RWops := glBitmapCreateRWops(aStream);
5505   try
5506     if IMG_isPNG(RWops) > 0 then begin
5507       Surface := IMG_LoadPNG_RW(RWops);
5508       try
5509         AssignFromSurface(Surface);
5510         result := true;
5511       finally
5512         SDL_FreeSurface(Surface);
5513       end;
5514     end;
5515   finally
5516     SDL_FreeRW(RWops);
5517   end;
5518 end;
5519
5520 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5522 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5523 begin
5524   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5525 end;
5526
5527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5528 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5529 var
5530   StreamPos: Int64;
5531   signature: array [0..7] of byte;
5532   png: png_structp;
5533   png_info: png_infop;
5534
5535   TempHeight, TempWidth: Integer;
5536   Format: TglBitmapInternalFormat;
5537
5538   png_data: pByte;
5539   png_rows: array of pByte;
5540   Row, LineSize: Integer;
5541 begin
5542   result := false;
5543
5544   if not init_libPNG then
5545     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5546
5547   try
5548     // signature
5549     StreamPos := Stream.Position;
5550     Stream.Read(signature, 8);
5551     Stream.Position := StreamPos;
5552
5553     if png_check_sig(@signature, 8) <> 0 then begin
5554       // png read struct
5555       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5556       if png = nil then
5557         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5558
5559       // png info
5560       png_info := png_create_info_struct(png);
5561       if png_info = nil then begin
5562         png_destroy_read_struct(@png, nil, nil);
5563         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5564       end;
5565
5566       // set read callback
5567       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
5568
5569       // read informations
5570       png_read_info(png, png_info);
5571
5572       // size 
5573       TempHeight := png_get_image_height(png, png_info);
5574       TempWidth := png_get_image_width(png, png_info);
5575
5576       // format
5577       case png_get_color_type(png, png_info) of
5578         PNG_COLOR_TYPE_GRAY:
5579           Format := tfLuminance8;
5580         PNG_COLOR_TYPE_GRAY_ALPHA:
5581           Format := tfLuminance8Alpha8;
5582         PNG_COLOR_TYPE_RGB:
5583           Format := tfRGB8;
5584         PNG_COLOR_TYPE_RGB_ALPHA:
5585           Format := tfRGBA8;
5586         else
5587           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5588       end;
5589
5590       // cut upper 8 bit from 16 bit formats
5591       if png_get_bit_depth(png, png_info) > 8 then
5592         png_set_strip_16(png);
5593
5594       // expand bitdepth smaller than 8
5595       if png_get_bit_depth(png, png_info) < 8 then
5596         png_set_expand(png);
5597
5598       // allocating mem for scanlines
5599       LineSize := png_get_rowbytes(png, png_info);
5600       GetMem(png_data, TempHeight * LineSize);
5601       try
5602         SetLength(png_rows, TempHeight);
5603         for Row := Low(png_rows) to High(png_rows) do begin
5604           png_rows[Row] := png_data;
5605           Inc(png_rows[Row], Row * LineSize);
5606         end;
5607
5608         // read complete image into scanlines
5609         png_read_image(png, @png_rows[0]);
5610
5611         // read end
5612         png_read_end(png, png_info);
5613
5614         // destroy read struct
5615         png_destroy_read_struct(@png, @png_info, nil);
5616
5617         SetLength(png_rows, 0);
5618
5619         // set new data
5620         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5621
5622         result := true;
5623       except
5624         FreeMem(png_data);
5625         raise;
5626       end;
5627     end;
5628   finally
5629     quit_libPNG;
5630   end;
5631 end;
5632
5633 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5634 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5635 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5636 var
5637   StreamPos: Int64;
5638   Png: TPNGObject;
5639   Header: Array[0..7] of Byte;
5640   Row, Col, PixSize, LineSize: Integer;
5641   NewImage, pSource, pDest, pAlpha: pByte;
5642   Format: TglBitmapInternalFormat;
5643
5644 const
5645   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
5646
5647 begin
5648   result := false;
5649
5650   StreamPos := Stream.Position;
5651   Stream.Read(Header[0], SizeOf(Header));
5652   Stream.Position := StreamPos;
5653
5654   {Test if the header matches}
5655   if Header = PngHeader then begin
5656     Png := TPNGObject.Create;
5657     try
5658       Png.LoadFromStream(Stream);
5659
5660       case Png.Header.ColorType of
5661         COLOR_GRAYSCALE:
5662           Format := ifLuminance;
5663         COLOR_GRAYSCALEALPHA:
5664           Format := ifLuminanceAlpha;
5665         COLOR_RGB:
5666           Format := ifBGR8;
5667         COLOR_RGBALPHA:
5668           Format := ifBGRA8;
5669         else
5670           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5671       end;
5672
5673       PixSize := Trunc(FormatGetSize(Format));
5674       LineSize := Integer(Png.Header.Width) * PixSize;
5675
5676       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5677       try
5678         pDest := NewImage;
5679
5680         case Png.Header.ColorType of
5681           COLOR_RGB, COLOR_GRAYSCALE:
5682             begin
5683               for Row := 0 to Png.Height -1 do begin
5684                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5685                 Inc(pDest, LineSize);
5686               end;
5687             end;
5688           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5689             begin
5690               PixSize := PixSize -1;
5691
5692               for Row := 0 to Png.Height -1 do begin
5693                 pSource := Png.Scanline[Row];
5694                 pAlpha := pByte(Png.AlphaScanline[Row]);
5695
5696                 for Col := 0 to Png.Width -1 do begin
5697                   Move (pSource^, pDest^, PixSize);
5698                   Inc(pSource, PixSize);
5699                   Inc(pDest, PixSize);
5700
5701                   pDest^ := pAlpha^;
5702                   inc(pAlpha);
5703                   Inc(pDest);
5704                 end;
5705               end;
5706             end;
5707           else
5708             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5709         end;
5710
5711         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
5712
5713         result := true;
5714       except
5715         FreeMem(NewImage);
5716         raise;
5717       end;
5718     finally
5719       Png.Free;
5720     end;
5721   end;
5722 end;
5723 {$IFEND}
5724 {$ENDIF}
5725
5726 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5727 {$IFDEF GLB_LIB_PNG}
5728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5729 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5730 begin
5731   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5732 end;
5733 {$ENDIF}
5734
5735 {$IF DEFINED(GLB_LIB_PNG)}
5736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5737 procedure TglBitmap.SavePNG(const aStream: TStream);
5738 var
5739   png: png_structp;
5740   png_info: png_infop;
5741   png_rows: array of pByte;
5742   LineSize: Integer;
5743   ColorType: Integer;
5744   Row: Integer;
5745 begin
5746   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5747     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5748
5749   if not init_libPNG then
5750     raise Exception.Create('SavePNG - unable to initialize libPNG.');
5751
5752   try
5753     case FInternalFormat of
5754       ifAlpha, ifLuminance, ifDepth8:
5755         ColorType := PNG_COLOR_TYPE_GRAY;
5756       ifLuminanceAlpha:
5757         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5758       ifBGR8, ifRGB8:
5759         ColorType := PNG_COLOR_TYPE_RGB;
5760       ifBGRA8, ifRGBA8:
5761         ColorType := PNG_COLOR_TYPE_RGBA;
5762       else
5763         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5764     end;
5765     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
5766
5767     // creating array for scanline
5768     SetLength(png_rows, Height);
5769     try
5770       for Row := 0 to Height - 1 do begin
5771         png_rows[Row] := Data;
5772         Inc(png_rows[Row], Row * LineSize)
5773       end;
5774
5775       // write struct
5776       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5777       if png = nil then
5778         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5779
5780       // create png info
5781       png_info := png_create_info_struct(png);
5782       if png_info = nil then begin
5783         png_destroy_write_struct(@png, nil);
5784         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5785       end;
5786
5787       // set read callback
5788       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
5789
5790       // set compression
5791       png_set_compression_level(png, 6);
5792
5793       if InternalFormat in [ifBGR8, ifBGRA8] then
5794         png_set_bgr(png);
5795
5796       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5797       png_write_info(png, png_info);
5798       png_write_image(png, @png_rows[0]);
5799       png_write_end(png, png_info);
5800       png_destroy_write_struct(@png, @png_info);
5801     finally
5802       SetLength(png_rows, 0);
5803     end;
5804   finally
5805     quit_libPNG;
5806   end;
5807 end;
5808
5809 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5811 procedure TglBitmap.SavePNG(const aStream: TStream);
5812 var
5813   Png: TPNGObject;
5814
5815   pSource, pDest: pByte;
5816   X, Y, PixSize: Integer;
5817   ColorType: Cardinal;
5818   Alpha: Boolean;
5819
5820   pTemp: pByte;
5821   Temp: Byte;
5822 begin
5823   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5824     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5825
5826   case FInternalFormat of
5827     ifAlpha, ifLuminance, ifDepth8: begin
5828       ColorType := COLOR_GRAYSCALE;
5829       PixSize := 1;
5830       Alpha := false;
5831     end;
5832     ifLuminanceAlpha: begin
5833       ColorType := COLOR_GRAYSCALEALPHA;
5834       PixSize := 1;
5835       Alpha := true;
5836     end;
5837     ifBGR8, ifRGB8: begin
5838       ColorType := COLOR_RGB;
5839       PixSize := 3;
5840       Alpha := false;
5841     end;
5842     ifBGRA8, ifRGBA8: begin
5843       ColorType := COLOR_RGBALPHA;
5844       PixSize := 3;
5845       Alpha := true
5846     end;
5847   else
5848     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5849   end;
5850
5851   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5852   try
5853     // Copy ImageData
5854     pSource := Data;
5855     for Y := 0 to Height -1 do begin
5856       pDest := png.ScanLine[Y];
5857       for X := 0 to Width -1 do begin
5858         Move(pSource^, pDest^, PixSize);
5859         Inc(pDest, PixSize);
5860         Inc(pSource, PixSize);
5861         if Alpha then begin
5862           png.AlphaScanline[Y]^[X] := pSource^;
5863           Inc(pSource);
5864         end;
5865       end;
5866
5867       // convert RGB line to BGR
5868       if InternalFormat in [ifRGB8, ifRGBA8] then begin
5869         pTemp := png.ScanLine[Y];
5870         for X := 0 to Width -1 do begin
5871           Temp := pByteArray(pTemp)^[0];
5872           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5873           pByteArray(pTemp)^[2] := Temp;
5874           Inc(pTemp, 3);
5875         end;
5876       end;
5877     end;
5878
5879     // Save to Stream
5880     Png.CompressionLevel := 6;
5881     Png.SaveToStream(Stream);
5882   finally
5883     FreeAndNil(Png);
5884   end;
5885 end;
5886 {$IFEND}
5887 {$ENDIF}
5888
5889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5890 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5892 {$IFDEF GLB_LIB_JPEG}
5893 type
5894   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5895   glBitmap_libJPEG_source_mgr = record
5896     pub: jpeg_source_mgr;
5897
5898     SrcStream: TStream;
5899     SrcBuffer: array [1..4096] of byte;
5900   end;
5901
5902   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5903   glBitmap_libJPEG_dest_mgr = record
5904     pub: jpeg_destination_mgr;
5905
5906     DestStream: TStream;
5907     DestBuffer: array [1..4096] of byte;
5908   end;
5909
5910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5911 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5912 var
5913   src: glBitmap_libJPEG_source_mgr_ptr;
5914   bytes: integer;
5915 begin
5916   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5917
5918   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5919         if (bytes <= 0) then begin
5920                 src^.SrcBuffer[1] := $FF;
5921                 src^.SrcBuffer[2] := JPEG_EOI;
5922                 bytes := 2;
5923         end;
5924
5925         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5926         src^.pub.bytes_in_buffer := bytes;
5927
5928   result := true;
5929 end;
5930
5931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5932 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5933 var
5934   src: glBitmap_libJPEG_source_mgr_ptr;
5935 begin
5936   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5937
5938   if num_bytes > 0 then begin
5939     // wanted byte isn't in buffer so set stream position and read buffer
5940     if num_bytes > src^.pub.bytes_in_buffer then begin
5941       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5942       src^.pub.fill_input_buffer(cinfo);
5943     end else begin
5944       // wanted byte is in buffer so only skip
5945                 inc(src^.pub.next_input_byte, num_bytes);
5946                 dec(src^.pub.bytes_in_buffer, num_bytes);
5947     end;
5948   end;
5949 end;
5950
5951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5952 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5953 var
5954   dest: glBitmap_libJPEG_dest_mgr_ptr;
5955 begin
5956   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5957
5958   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5959     // write complete buffer
5960     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5961
5962     // reset buffer
5963     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5964     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5965   end;
5966
5967   result := true;
5968 end;
5969
5970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5971 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5972 var
5973   Idx: Integer;
5974   dest: glBitmap_libJPEG_dest_mgr_ptr;
5975 begin
5976   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5977
5978   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5979     // check for endblock
5980     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5981       // write endblock
5982       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5983
5984       // leave
5985       break;
5986     end else
5987       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5988   end;
5989 end;
5990 {$ENDIF}
5991
5992 {$IFDEF GLB_SUPPORT_JPEG_READ}
5993 {$IF DEFINED(GLB_SDL_IMAGE)}
5994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5995 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
5996 var
5997   Surface: PSDL_Surface;
5998   RWops: PSDL_RWops;
5999 begin
6000   result := false;
6001
6002   RWops := glBitmapCreateRWops(aStream);
6003   try
6004     if IMG_isJPG(RWops) > 0 then begin
6005       Surface := IMG_LoadJPG_RW(RWops);
6006       try
6007         AssignFromSurface(Surface);
6008         result := true;
6009       finally
6010         SDL_FreeSurface(Surface);
6011       end;
6012     end;
6013   finally
6014     SDL_FreeRW(RWops);
6015   end;
6016 end;
6017
6018 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6020 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6021 var
6022   StreamPos: Int64;
6023   Temp: array[0..1]of Byte;
6024
6025   jpeg: jpeg_decompress_struct;
6026   jpeg_err: jpeg_error_mgr;
6027
6028   IntFormat: TglBitmapInternalFormat;
6029   pImage: pByte;
6030   TempHeight, TempWidth: Integer;
6031
6032   pTemp: pByte;
6033   Row: Integer;
6034 begin
6035   result := false;
6036
6037   if not init_libJPEG then
6038     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6039
6040   try
6041     // reading first two bytes to test file and set cursor back to begin
6042     StreamPos := Stream.Position;
6043     Stream.Read(Temp[0], 2);
6044     Stream.Position := StreamPos;
6045
6046     // if Bitmap then read file.
6047     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6048       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
6049       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
6050
6051       // error managment
6052       jpeg.err := jpeg_std_error(@jpeg_err);
6053       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6054       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6055
6056       // decompression struct
6057       jpeg_create_decompress(@jpeg);
6058
6059       // allocation space for streaming methods
6060       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6061
6062       // seeting up custom functions
6063       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6064         pub.init_source       := glBitmap_libJPEG_init_source;
6065         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6066         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6067         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6068         pub.term_source       := glBitmap_libJPEG_term_source;
6069
6070         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6071         pub.next_input_byte := nil;   // until buffer loaded
6072
6073         SrcStream := Stream;
6074       end;
6075
6076       // set global decoding state
6077       jpeg.global_state := DSTATE_START;
6078
6079       // read header of jpeg
6080       jpeg_read_header(@jpeg, false);
6081
6082       // setting output parameter
6083       case jpeg.jpeg_color_space of
6084         JCS_GRAYSCALE:
6085           begin
6086             jpeg.out_color_space := JCS_GRAYSCALE;
6087             IntFormat := ifLuminance;
6088           end;
6089         else
6090           jpeg.out_color_space := JCS_RGB;
6091           IntFormat := ifRGB8;
6092       end;
6093
6094       // reading image
6095       jpeg_start_decompress(@jpeg);
6096
6097       TempHeight := jpeg.output_height;
6098       TempWidth := jpeg.output_width;
6099
6100       // creating new image
6101       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
6102       try
6103         pTemp := pImage;
6104
6105         for Row := 0 to TempHeight -1 do begin
6106           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6107           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
6108         end;
6109
6110         // finish decompression
6111         jpeg_finish_decompress(@jpeg);
6112
6113         // destroy decompression
6114         jpeg_destroy_decompress(@jpeg);
6115
6116         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6117
6118         result := true;
6119       except
6120         FreeMem(pImage);
6121         raise;
6122       end;
6123     end;
6124   finally
6125     quit_libJPEG;
6126   end;
6127 end;
6128
6129 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6131 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6132 var
6133   bmp: TBitmap;
6134   jpg: TJPEGImage;
6135   StreamPos: Int64;
6136   Temp: array[0..1]of Byte;
6137 begin
6138   result := false;
6139
6140   // reading first two bytes to test file and set cursor back to begin
6141   StreamPos := Stream.Position;
6142   Stream.Read(Temp[0], 2);
6143   Stream.Position := StreamPos;
6144
6145   // if Bitmap then read file.
6146   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6147     bmp := TBitmap.Create;
6148     try
6149       jpg := TJPEGImage.Create;
6150       try
6151         jpg.LoadFromStream(Stream);
6152         bmp.Assign(jpg);
6153         result := AssignFromBitmap(bmp);
6154       finally
6155         jpg.Free;
6156       end;
6157     finally
6158       bmp.Free;
6159     end;
6160   end;
6161 end;
6162 {$IFEND}
6163 {$ENDIF}
6164
6165 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6166 {$IF DEFEFINED(GLB_LIB_JPEG)}
6167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6168 procedure TglBitmap.SaveJPEG(Stream: TStream);
6169 var
6170   jpeg: jpeg_compress_struct;
6171   jpeg_err: jpeg_error_mgr;
6172   Row: Integer;
6173   pTemp, pTemp2: pByte;
6174
6175   procedure CopyRow(pDest, pSource: pByte);
6176   var
6177     X: Integer;
6178   begin
6179     for X := 0 to Width - 1 do begin
6180       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6181       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6182       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6183       Inc(pDest, 3);
6184       Inc(pSource, 3);
6185     end;
6186   end;
6187
6188 begin
6189   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6190     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6191
6192   if not init_libJPEG then
6193     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6194
6195   try
6196     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
6197     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
6198
6199     // error managment
6200     jpeg.err := jpeg_std_error(@jpeg_err);
6201     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6202     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6203
6204     // compression struct
6205     jpeg_create_compress(@jpeg);
6206
6207     // allocation space for streaming methods
6208     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6209
6210     // seeting up custom functions
6211     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6212       pub.init_destination    := glBitmap_libJPEG_init_destination;
6213       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6214       pub.term_destination    := glBitmap_libJPEG_term_destination;
6215
6216       pub.next_output_byte  := @DestBuffer[1];
6217       pub.free_in_buffer    := Length(DestBuffer);
6218
6219       DestStream := Stream;
6220     end;
6221
6222     // very important state
6223     jpeg.global_state := CSTATE_START;
6224     jpeg.image_width  := Width;
6225     jpeg.image_height := Height;
6226     case InternalFormat of
6227       ifAlpha, ifLuminance, ifDepth8: begin
6228         jpeg.input_components := 1;
6229         jpeg.in_color_space := JCS_GRAYSCALE;
6230       end;
6231       ifRGB8, ifBGR8: begin
6232         jpeg.input_components := 3;
6233         jpeg.in_color_space := JCS_RGB;
6234       end;
6235     end;
6236
6237     jpeg_set_defaults(@jpeg);
6238     jpeg_set_quality(@jpeg, 95, true);
6239     jpeg_start_compress(@jpeg, true);
6240     pTemp := Data;
6241
6242     if InternalFormat = ifBGR8 then
6243       GetMem(pTemp2, fRowSize)
6244     else
6245       pTemp2 := pTemp;
6246
6247     try
6248       for Row := 0 to jpeg.image_height -1 do begin
6249         // prepare row
6250         if InternalFormat = ifBGR8 then
6251           CopyRow(pTemp2, pTemp)
6252         else
6253           pTemp2 := pTemp;
6254
6255         // write row
6256         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6257         inc(pTemp, fRowSize);
6258       end;
6259     finally
6260       // free memory
6261       if InternalFormat = ifBGR8 then
6262         FreeMem(pTemp2);
6263     end;
6264     jpeg_finish_compress(@jpeg);
6265     jpeg_destroy_compress(@jpeg);
6266   finally
6267     quit_libJPEG;
6268   end;
6269 end;
6270
6271 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6273 procedure TglBitmap.SaveJPEG(Stream: TStream);
6274 var
6275   Bmp: TBitmap;
6276   Jpg: TJPEGImage;
6277 begin
6278   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6279     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6280
6281   Bmp := TBitmap.Create;
6282   try
6283     Jpg := TJPEGImage.Create;
6284     try
6285       AssignToBitmap(Bmp);
6286       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6287         Jpg.Grayscale := true;
6288         Jpg.PixelFormat := jf8Bit;
6289       end;
6290       Jpg.Assign(Bmp);
6291       Jpg.SaveToStream(Stream);
6292     finally
6293       FreeAndNil(Jpg);
6294     end;
6295   finally
6296     FreeAndNil(Bmp);
6297   end;
6298 end;
6299 {$ENDIF}
6300 {$ENDIF}
6301
6302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6303 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6305 const
6306   BMP_MAGIC          = $4D42;
6307
6308   BMP_COMP_RGB       = 0;
6309   BMP_COMP_RLE8      = 1;
6310   BMP_COMP_RLE4      = 2;
6311   BMP_COMP_BITFIELDS = 3;
6312
6313 type
6314   TBMPHeader = packed record
6315     bfType: Word;
6316     bfSize: Cardinal;
6317     bfReserved1: Word;
6318     bfReserved2: Word;
6319     bfOffBits: Cardinal;
6320   end;
6321
6322   TBMPInfo = packed record
6323     biSize: Cardinal;
6324     biWidth: Longint;
6325     biHeight: Longint;
6326     biPlanes: Word;
6327     biBitCount: Word;
6328     biCompression: Cardinal;
6329     biSizeImage: Cardinal;
6330     biXPelsPerMeter: Longint;
6331     biYPelsPerMeter: Longint;
6332     biClrUsed: Cardinal;
6333     biClrImportant: Cardinal;
6334   end;
6335
6336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6337 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6338
6339   //////////////////////////////////////////////////////////////////////////////////////////////////
6340   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6341   begin
6342     result := tfEmpty;
6343     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6344     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6345
6346     //Read Compression
6347     case aInfo.biCompression of
6348       BMP_COMP_RLE4,
6349       BMP_COMP_RLE8: begin
6350         raise EglBitmapException.Create('RLE compression is not supported');
6351       end;
6352       BMP_COMP_BITFIELDS: begin
6353         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6354           aStream.Read(aMask.r, SizeOf(aMask.r));
6355           aStream.Read(aMask.g, SizeOf(aMask.g));
6356           aStream.Read(aMask.b, SizeOf(aMask.b));
6357           aStream.Read(aMask.a, SizeOf(aMask.a));
6358         end else
6359           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6360       end;
6361     end;
6362
6363     //get suitable format
6364     case aInfo.biBitCount of
6365        8: result := tfLuminance8;
6366       16: result := tfBGR5;
6367       24: result := tfBGR8;
6368       32: result := tfBGRA8;
6369     end;
6370   end;
6371
6372   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6373   var
6374     i, c: Integer;
6375     ColorTable: TbmpColorTable;
6376   begin
6377     result := nil;
6378     if (aInfo.biBitCount >= 16) then
6379       exit;
6380     aFormat := tfLuminance8;
6381     c := aInfo.biClrUsed;
6382     if (c = 0) then
6383       c := 1 shl aInfo.biBitCount;
6384     SetLength(ColorTable, c);
6385     for i := 0 to c-1 do begin
6386       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6387       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6388         aFormat := tfRGB8;
6389     end;
6390
6391     result := TbmpColorTableFormat.Create;
6392     result.PixelSize  := aInfo.biBitCount / 8;
6393     result.ColorTable := ColorTable;
6394     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6395   end;
6396
6397   //////////////////////////////////////////////////////////////////////////////////////////////////
6398   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6399     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6400   var
6401     TmpFormat: TglBitmapFormat;
6402     FormatDesc: TFormatDescriptor;
6403   begin
6404     result := nil;
6405     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6406       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6407         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6408         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6409           aFormat := FormatDesc.Format;
6410           exit;
6411         end;
6412       end;
6413
6414       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6415         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6416       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6417         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6418
6419       result := TbmpBitfieldFormat.Create;
6420       result.PixelSize := aInfo.biBitCount / 8;
6421       result.RedMask   := aMask.r;
6422       result.GreenMask := aMask.g;
6423       result.BlueMask  := aMask.b;
6424       result.AlphaMask := aMask.a;
6425     end;
6426   end;
6427
6428 var
6429   //simple types
6430   StartPos: Int64;
6431   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6432   PaddingBuff: Cardinal;
6433   LineBuf, ImageData, TmpData: PByte;
6434   SourceMD, DestMD: Pointer;
6435   BmpFormat: TglBitmapFormat;
6436
6437   //records
6438   Mask: TglBitmapColorRec;
6439   Header: TBMPHeader;
6440   Info: TBMPInfo;
6441
6442   //classes
6443   SpecialFormat: TFormatDescriptor;
6444   FormatDesc: TFormatDescriptor;
6445
6446   //////////////////////////////////////////////////////////////////////////////////////////////////
6447   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6448   var
6449     i: Integer;
6450     Pixel: TglBitmapPixelData;
6451   begin
6452     aStream.Read(aLineBuf^, rbLineSize);
6453     SpecialFormat.PreparePixel(Pixel);
6454     for i := 0 to Info.biWidth-1 do begin
6455       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6456       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6457       FormatDesc.Map(Pixel, aData, DestMD);
6458     end;
6459   end;
6460
6461 begin
6462   result        := false;
6463   BmpFormat     := tfEmpty;
6464   SpecialFormat := nil;
6465   LineBuf       := nil;
6466   SourceMD      := nil;
6467   DestMD        := nil;
6468
6469   // Header
6470   StartPos := aStream.Position;
6471   aStream.Read(Header{%H-}, SizeOf(Header));
6472
6473   if Header.bfType = BMP_MAGIC then begin
6474     try try
6475       BmpFormat        := ReadInfo(Info, Mask);
6476       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6477       if not Assigned(SpecialFormat) then
6478         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6479       aStream.Position := StartPos + Header.bfOffBits;
6480
6481       if (BmpFormat <> tfEmpty) then begin
6482         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6483         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6484         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6485         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6486
6487         //get Memory
6488         DestMD    := FormatDesc.CreateMappingData;
6489         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6490         GetMem(ImageData, ImageSize);
6491         if Assigned(SpecialFormat) then begin
6492           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6493           SourceMD := SpecialFormat.CreateMappingData;
6494         end;
6495
6496         //read Data
6497         try try
6498           FillChar(ImageData^, ImageSize, $FF);
6499           TmpData := ImageData;
6500           if (Info.biHeight > 0) then
6501             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6502           for i := 0 to Abs(Info.biHeight)-1 do begin
6503             if Assigned(SpecialFormat) then
6504               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6505             else
6506               aStream.Read(TmpData^, wbLineSize);   //else only read data
6507             if (Info.biHeight > 0) then
6508               dec(TmpData, wbLineSize)
6509             else
6510               inc(TmpData, wbLineSize);
6511             aStream.Read(PaddingBuff{%H-}, Padding);
6512           end;
6513           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6514           result := true;
6515         finally
6516           if Assigned(LineBuf) then
6517             FreeMem(LineBuf);
6518           if Assigned(SourceMD) then
6519             SpecialFormat.FreeMappingData(SourceMD);
6520           FormatDesc.FreeMappingData(DestMD);
6521         end;
6522         except
6523           FreeMem(ImageData);
6524           raise;
6525         end;
6526       end else
6527         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6528     except
6529       aStream.Position := StartPos;
6530       raise;
6531     end;
6532     finally
6533       FreeAndNil(SpecialFormat);
6534     end;
6535   end
6536     else aStream.Position := StartPos;
6537 end;
6538
6539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6540 procedure TglBitmap.SaveBMP(const aStream: TStream);
6541 var
6542   Header: TBMPHeader;
6543   Info: TBMPInfo;
6544   Converter: TbmpColorTableFormat;
6545   FormatDesc: TFormatDescriptor;
6546   SourceFD, DestFD: Pointer;
6547   pData, srcData, dstData, ConvertBuffer: pByte;
6548
6549   Pixel: TglBitmapPixelData;
6550   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6551   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6552
6553   PaddingBuff: Cardinal;
6554
6555   function GetLineWidth : Integer;
6556   begin
6557     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6558   end;
6559
6560 begin
6561   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6562     raise EglBitmapUnsupportedFormat.Create('SaveBMP');
6563
6564   Converter  := nil;
6565   FormatDesc := TFormatDescriptor.Get(Format);
6566   ImageSize  := FormatDesc.GetSize(Dimension);
6567
6568   FillChar(Header{%H-}, SizeOf(Header), 0);
6569   Header.bfType      := BMP_MAGIC;
6570   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6571   Header.bfReserved1 := 0;
6572   Header.bfReserved2 := 0;
6573   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6574
6575   FillChar(Info{%H-}, SizeOf(Info), 0);
6576   Info.biSize        := SizeOf(Info);
6577   Info.biWidth       := Width;
6578   Info.biHeight      := Height;
6579   Info.biPlanes      := 1;
6580   Info.biCompression := BMP_COMP_RGB;
6581   Info.biSizeImage   := ImageSize;
6582
6583   try
6584     case Format of
6585       tfLuminance4: begin
6586         Info.biBitCount  := 4;
6587         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6588         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6589         Converter           := TbmpColorTableFormat.Create;
6590         Converter.PixelSize := 0.5;
6591         Converter.Format    := Format;
6592         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6593         Converter.CreateColorTable;
6594       end;
6595
6596       tfR3G3B2, tfLuminance8: begin
6597         Info.biBitCount  :=  8;
6598         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6599         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6600         Converter           := TbmpColorTableFormat.Create;
6601         Converter.PixelSize := 1;
6602         Converter.Format    := Format;
6603         if (Format = tfR3G3B2) then begin
6604           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6605           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6606         end else
6607           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6608         Converter.CreateColorTable;
6609       end;
6610
6611       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6612       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6613         Info.biBitCount    := 16;
6614         Info.biCompression := BMP_COMP_BITFIELDS;
6615       end;
6616
6617       tfBGR8, tfRGB8: begin
6618         Info.biBitCount := 24;
6619       end;
6620
6621       tfRGB10, tfRGB10A2, tfRGBA8,
6622       tfBGR10, tfBGR10A2, tfBGRA8: begin
6623         Info.biBitCount    := 32;
6624         Info.biCompression := BMP_COMP_BITFIELDS;
6625       end;
6626     else
6627       raise EglBitmapUnsupportedFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6628     end;
6629     Info.biXPelsPerMeter := 2835;
6630     Info.biYPelsPerMeter := 2835;
6631
6632     // prepare bitmasks
6633     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6634       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6635       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6636
6637       RedMask    := FormatDesc.RedMask;
6638       GreenMask  := FormatDesc.GreenMask;
6639       BlueMask   := FormatDesc.BlueMask;
6640       AlphaMask  := FormatDesc.AlphaMask;
6641     end;
6642
6643     // headers
6644     aStream.Write(Header, SizeOf(Header));
6645     aStream.Write(Info, SizeOf(Info));
6646
6647     // colortable
6648     if Assigned(Converter) then
6649       aStream.Write(Converter.ColorTable[0].b,
6650         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6651
6652     // bitmasks
6653     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6654       aStream.Write(RedMask,   SizeOf(Cardinal));
6655       aStream.Write(GreenMask, SizeOf(Cardinal));
6656       aStream.Write(BlueMask,  SizeOf(Cardinal));
6657       aStream.Write(AlphaMask, SizeOf(Cardinal));
6658     end;
6659
6660     // image data
6661     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6662     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6663     Padding     := GetLineWidth - wbLineSize;
6664     PaddingBuff := 0;
6665
6666     pData := Data;
6667     inc(pData, (Height-1) * rbLineSize);
6668
6669     // prepare row buffer. But only for RGB because RGBA supports color masks
6670     // so it's possible to change color within the image.
6671     if Assigned(Converter) then begin
6672       FormatDesc.PreparePixel(Pixel);
6673       GetMem(ConvertBuffer, wbLineSize);
6674       SourceFD := FormatDesc.CreateMappingData;
6675       DestFD   := Converter.CreateMappingData;
6676     end else
6677       ConvertBuffer := nil;
6678
6679     try
6680       for LineIdx := 0 to Height - 1 do begin
6681         // preparing row
6682         if Assigned(Converter) then begin
6683           srcData := pData;
6684           dstData := ConvertBuffer;
6685           for PixelIdx := 0 to Info.biWidth-1 do begin
6686             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6687             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6688             Converter.Map(Pixel, dstData, DestFD);
6689           end;
6690           aStream.Write(ConvertBuffer^, wbLineSize);
6691         end else begin
6692           aStream.Write(pData^, rbLineSize);
6693         end;
6694         dec(pData, rbLineSize);
6695         if (Padding > 0) then
6696           aStream.Write(PaddingBuff, Padding);
6697       end;
6698     finally
6699       // destroy row buffer
6700       if Assigned(ConvertBuffer) then begin
6701         FormatDesc.FreeMappingData(SourceFD);
6702         Converter.FreeMappingData(DestFD);
6703         FreeMem(ConvertBuffer);
6704       end;
6705     end;
6706   finally
6707     if Assigned(Converter) then
6708       Converter.Free;
6709   end;
6710 end;
6711
6712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6713 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6715 type
6716   TTGAHeader = packed record
6717     ImageID: Byte;
6718     ColorMapType: Byte;
6719     ImageType: Byte;
6720     //ColorMapSpec: Array[0..4] of Byte;
6721     ColorMapStart: Word;
6722     ColorMapLength: Word;
6723     ColorMapEntrySize: Byte;
6724     OrigX: Word;
6725     OrigY: Word;
6726     Width: Word;
6727     Height: Word;
6728     Bpp: Byte;
6729     ImageDesc: Byte;
6730   end;
6731
6732 const
6733   TGA_UNCOMPRESSED_RGB  =  2;
6734   TGA_UNCOMPRESSED_GRAY =  3;
6735   TGA_COMPRESSED_RGB    = 10;
6736   TGA_COMPRESSED_GRAY   = 11;
6737
6738   TGA_NONE_COLOR_TABLE  = 0;
6739
6740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6741 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6742 var
6743   Header: TTGAHeader;
6744   ImageData: System.PByte;
6745   StartPosition: Int64;
6746   PixelSize, LineSize: Integer;
6747   tgaFormat: TglBitmapFormat;
6748   FormatDesc: TFormatDescriptor;
6749   Counter: packed record
6750     X, Y: packed record
6751       low, high, dir: Integer;
6752     end;
6753   end;
6754
6755 const
6756   CACHE_SIZE = $4000;
6757
6758   ////////////////////////////////////////////////////////////////////////////////////////
6759   procedure ReadUncompressed;
6760   var
6761     i, j: Integer;
6762     buf, tmp1, tmp2: System.PByte;
6763   begin
6764     buf := nil;
6765     if (Counter.X.dir < 0) then
6766       buf := GetMem(LineSize);
6767     try
6768       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6769         tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6770         if (Counter.X.dir < 0) then begin               //flip X
6771           aStream.Read(buf^, LineSize);
6772           tmp2 := buf + LineSize - PixelSize;           //pointer to last pixel in line
6773           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6774             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6775               tmp1^ := tmp2^;
6776               inc(tmp1);
6777               inc(tmp2);
6778             end;
6779             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6780           end;
6781         end else
6782           aStream.Read(tmp1^, LineSize);
6783         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6784       end;
6785     finally
6786       if Assigned(buf) then
6787         FreeMem(buf);
6788     end;
6789   end;
6790
6791   ////////////////////////////////////////////////////////////////////////////////////////
6792   procedure ReadCompressed;
6793
6794     /////////////////////////////////////////////////////////////////
6795     var
6796       TmpData: System.PByte;
6797       LinePixelsRead: Integer;
6798     procedure CheckLine;
6799     begin
6800       if (LinePixelsRead >= Header.Width) then begin
6801         LinePixelsRead := 0;
6802         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6803         TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6804         if (Counter.X.dir < 0) then                       //if x flipped then
6805           TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6806       end;
6807     end;
6808
6809     /////////////////////////////////////////////////////////////////
6810     var
6811       Cache: PByte;
6812       CacheSize, CachePos: Integer;
6813     procedure CachedRead(out Buffer; Count: Integer);
6814     var
6815       BytesRead: Integer;
6816     begin
6817       if (CachePos + Count > CacheSize) then begin
6818         //if buffer overflow save non read bytes
6819         BytesRead := 0;
6820         if (CacheSize - CachePos > 0) then begin
6821           BytesRead := CacheSize - CachePos;
6822           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6823           inc(CachePos, BytesRead);
6824         end;
6825
6826         //load cache from file
6827         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6828         aStream.Read(Cache^, CacheSize);
6829         CachePos := 0;
6830
6831         //read rest of requested bytes
6832         if (Count - BytesRead > 0) then begin
6833           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6834           inc(CachePos, Count - BytesRead);
6835         end;
6836       end else begin
6837         //if no buffer overflow just read the data
6838         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6839         inc(CachePos, Count);
6840       end;
6841     end;
6842
6843     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6844     begin
6845       case PixelSize of
6846         1: begin
6847           aBuffer^ := aData^;
6848           inc(aBuffer, Counter.X.dir);
6849         end;
6850         2: begin
6851           PWord(aBuffer)^ := PWord(aData)^;
6852           inc(aBuffer, 2 * Counter.X.dir);
6853         end;
6854         3: begin
6855           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6856           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6857           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6858           inc(aBuffer, 3 * Counter.X.dir);
6859         end;
6860         4: begin
6861           PCardinal(aBuffer)^ := PCardinal(aData)^;
6862           inc(aBuffer, 4 * Counter.X.dir);
6863         end;
6864       end;
6865     end;
6866
6867   var
6868     TotalPixelsToRead, TotalPixelsRead: Integer;
6869     Temp: Byte;
6870     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6871     PixelRepeat: Boolean;
6872     PixelsToRead, PixelCount: Integer;
6873   begin
6874     CacheSize := 0;
6875     CachePos  := 0;
6876
6877     TotalPixelsToRead := Header.Width * Header.Height;
6878     TotalPixelsRead   := 0;
6879     LinePixelsRead    := 0;
6880
6881     GetMem(Cache, CACHE_SIZE);
6882     try
6883       TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6884       if (Counter.X.dir < 0) then                       //if x flipped then
6885         TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6886
6887       repeat
6888         //read CommandByte
6889         CachedRead(Temp, 1);
6890         PixelRepeat  := (Temp and $80) > 0;
6891         PixelsToRead := (Temp and $7F) + 1;
6892         inc(TotalPixelsRead, PixelsToRead);
6893
6894         if PixelRepeat then
6895           CachedRead(buf[0], PixelSize);
6896         while (PixelsToRead > 0) do begin
6897           CheckLine;
6898           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6899           while (PixelCount > 0) do begin
6900             if not PixelRepeat then
6901               CachedRead(buf[0], PixelSize);
6902             PixelToBuffer(@buf[0], TmpData);
6903             inc(LinePixelsRead);
6904             dec(PixelsToRead);
6905             dec(PixelCount);
6906           end;
6907         end;
6908       until (TotalPixelsRead >= TotalPixelsToRead);
6909     finally
6910       FreeMem(Cache);
6911     end;
6912   end;
6913
6914   function IsGrayFormat: Boolean;
6915   begin
6916     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6917   end;
6918
6919 begin
6920   result := false;
6921
6922   // reading header to test file and set cursor back to begin
6923   StartPosition := aStream.Position;
6924   aStream.Read(Header{%H-}, SizeOf(Header));
6925
6926   // no colormapped files
6927   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6928     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6929   begin
6930     try
6931       if Header.ImageID <> 0 then       // skip image ID
6932         aStream.Position := aStream.Position + Header.ImageID;
6933
6934       case Header.Bpp of
6935          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6936                0: tgaFormat := tfLuminance8;
6937                8: tgaFormat := tfAlpha8;
6938             end;
6939
6940         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6941                0: tgaFormat := tfLuminance16;
6942                8: tgaFormat := tfLuminance8Alpha8;
6943             end else case (Header.ImageDesc and $F) of
6944                0: tgaFormat := tfBGR5;
6945                1: tgaFormat := tfBGR5A1;
6946                4: tgaFormat := tfBGRA4;
6947             end;
6948
6949         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6950                0: tgaFormat := tfBGR8;
6951             end;
6952
6953         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6954                2: tgaFormat := tfBGR10A2;
6955                8: tgaFormat := tfBGRA8;
6956             end;
6957       end;
6958
6959       if (tgaFormat = tfEmpty) then
6960         raise EglBitmapException.Create('LoadTga - unsupported format');
6961
6962       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6963       PixelSize  := FormatDesc.GetSize(1, 1);
6964       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6965
6966       GetMem(ImageData, LineSize * Header.Height);
6967       try
6968         //column direction
6969         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6970           Counter.X.low  := Header.Height-1;;
6971           Counter.X.high := 0;
6972           Counter.X.dir  := -1;
6973         end else begin
6974           Counter.X.low  := 0;
6975           Counter.X.high := Header.Height-1;
6976           Counter.X.dir  := 1;
6977         end;
6978
6979         // Row direction
6980         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6981           Counter.Y.low  := 0;
6982           Counter.Y.high := Header.Height-1;
6983           Counter.Y.dir  := 1;
6984         end else begin
6985           Counter.Y.low  := Header.Height-1;;
6986           Counter.Y.high := 0;
6987           Counter.Y.dir  := -1;
6988         end;
6989
6990         // Read Image
6991         case Header.ImageType of
6992           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6993             ReadUncompressed;
6994           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6995             ReadCompressed;
6996         end;
6997
6998         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
6999         result := true;
7000       except
7001         FreeMem(ImageData);
7002         raise;
7003       end;
7004     finally
7005       aStream.Position := StartPosition;
7006     end;
7007   end
7008     else aStream.Position := StartPosition;
7009 end;
7010
7011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7012 procedure TglBitmap.SaveTGA(const aStream: TStream);
7013 var
7014   Header: TTGAHeader;
7015   LineSize, Size, x, y: Integer;
7016   Pixel: TglBitmapPixelData;
7017   LineBuf, SourceData, DestData: PByte;
7018   SourceMD, DestMD: Pointer;
7019   FormatDesc: TFormatDescriptor;
7020   Converter: TFormatDescriptor;
7021 begin
7022   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7023     raise EglBitmapUnsupportedFormat.Create('SaveTGA');
7024
7025   //prepare header
7026   FillChar(Header{%H-}, SizeOf(Header), 0);
7027
7028   //set ImageType
7029   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7030                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7031     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7032   else
7033     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7034
7035   //set BitsPerPixel
7036   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7037     Header.Bpp := 8
7038   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7039                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7040     Header.Bpp := 16
7041   else if (Format in [tfBGR8, tfRGB8]) then
7042     Header.Bpp := 24
7043   else
7044     Header.Bpp := 32;
7045
7046   //set AlphaBitCount
7047   case Format of
7048     tfRGB5A1, tfBGR5A1:
7049       Header.ImageDesc := 1 and $F;
7050     tfRGB10A2, tfBGR10A2:
7051       Header.ImageDesc := 2 and $F;
7052     tfRGBA4, tfBGRA4:
7053       Header.ImageDesc := 4 and $F;
7054     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7055       Header.ImageDesc := 8 and $F;
7056   end;
7057
7058   Header.Width     := Width;
7059   Header.Height    := Height;
7060   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7061   aStream.Write(Header, SizeOf(Header));
7062
7063   // convert RGB(A) to BGR(A)
7064   Converter  := nil;
7065   FormatDesc := TFormatDescriptor.Get(Format);
7066   Size       := FormatDesc.GetSize(Dimension);
7067   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7068     if (FormatDesc.RGBInverted = tfEmpty) then
7069       raise EglBitmapException.Create('inverted RGB format is empty');
7070     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7071     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7072        (Converter.PixelSize <> FormatDesc.PixelSize) then
7073       raise EglBitmapException.Create('invalid inverted RGB format');
7074   end;
7075
7076   if Assigned(Converter) then begin
7077     LineSize := FormatDesc.GetSize(Width, 1);
7078     LineBuf  := GetMem(LineSize);
7079     SourceMD := FormatDesc.CreateMappingData;
7080     DestMD   := Converter.CreateMappingData;
7081     try
7082       SourceData := Data;
7083       for y := 0 to Height-1 do begin
7084         DestData := LineBuf;
7085         for x := 0 to Width-1 do begin
7086           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7087           Converter.Map(Pixel, DestData, DestMD);
7088         end;
7089         aStream.Write(LineBuf^, LineSize);
7090       end;
7091     finally
7092       FreeMem(LineBuf);
7093       FormatDesc.FreeMappingData(SourceMD);
7094       FormatDesc.FreeMappingData(DestMD);
7095     end;
7096   end else
7097     aStream.Write(Data^, Size);
7098 end;
7099
7100 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7101 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7103 const
7104   DDS_MAGIC: Cardinal         = $20534444;
7105
7106   // DDS_header.dwFlags
7107   DDSD_CAPS                   = $00000001;
7108   DDSD_HEIGHT                 = $00000002;
7109   DDSD_WIDTH                  = $00000004;
7110   DDSD_PIXELFORMAT            = $00001000;
7111
7112   // DDS_header.sPixelFormat.dwFlags
7113   DDPF_ALPHAPIXELS            = $00000001;
7114   DDPF_ALPHA                  = $00000002;
7115   DDPF_FOURCC                 = $00000004;
7116   DDPF_RGB                    = $00000040;
7117   DDPF_LUMINANCE              = $00020000;
7118
7119   // DDS_header.sCaps.dwCaps1
7120   DDSCAPS_TEXTURE             = $00001000;
7121
7122   // DDS_header.sCaps.dwCaps2
7123   DDSCAPS2_CUBEMAP            = $00000200;
7124
7125   D3DFMT_DXT1                 = $31545844;
7126   D3DFMT_DXT3                 = $33545844;
7127   D3DFMT_DXT5                 = $35545844;
7128
7129 type
7130   TDDSPixelFormat = packed record
7131     dwSize: Cardinal;
7132     dwFlags: Cardinal;
7133     dwFourCC: Cardinal;
7134     dwRGBBitCount: Cardinal;
7135     dwRBitMask: Cardinal;
7136     dwGBitMask: Cardinal;
7137     dwBBitMask: Cardinal;
7138     dwABitMask: Cardinal;
7139   end;
7140
7141   TDDSCaps = packed record
7142     dwCaps1: Cardinal;
7143     dwCaps2: Cardinal;
7144     dwDDSX: Cardinal;
7145     dwReserved: Cardinal;
7146   end;
7147
7148   TDDSHeader = packed record
7149     dwSize: Cardinal;
7150     dwFlags: Cardinal;
7151     dwHeight: Cardinal;
7152     dwWidth: Cardinal;
7153     dwPitchOrLinearSize: Cardinal;
7154     dwDepth: Cardinal;
7155     dwMipMapCount: Cardinal;
7156     dwReserved: array[0..10] of Cardinal;
7157     PixelFormat: TDDSPixelFormat;
7158     Caps: TDDSCaps;
7159     dwReserved2: Cardinal;
7160   end;
7161
7162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7163 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7164 var
7165   Header: TDDSHeader;
7166   Converter: TbmpBitfieldFormat;
7167
7168   function GetDDSFormat: TglBitmapFormat;
7169   var
7170     fd: TFormatDescriptor;
7171     i: Integer;
7172     Range: TglBitmapColorRec;
7173     match: Boolean;
7174   begin
7175     result := tfEmpty;
7176     with Header.PixelFormat do begin
7177       // Compresses
7178       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7179         case Header.PixelFormat.dwFourCC of
7180           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7181           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7182           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7183         end;
7184       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7185
7186         //find matching format
7187         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7188           fd := TFormatDescriptor.Get(result);
7189           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7190              (8 * fd.PixelSize = dwRGBBitCount) then
7191             exit;
7192         end;
7193
7194         //find format with same Range
7195         Range.r := dwRBitMask;
7196         Range.g := dwGBitMask;
7197         Range.b := dwBBitMask;
7198         Range.a := dwABitMask;
7199         for i := 0 to 3 do begin
7200           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7201             Range.arr[i] := Range.arr[i] shr 1;
7202         end;
7203         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7204           fd := TFormatDescriptor.Get(result);
7205           match := true;
7206           for i := 0 to 3 do
7207             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7208               match := false;
7209               break;
7210             end;
7211           if match then
7212             break;
7213         end;
7214
7215         //no format with same range found -> use default
7216         if (result = tfEmpty) then begin
7217           if (dwABitMask > 0) then
7218             result := tfBGRA8
7219           else
7220             result := tfBGR8;
7221         end;
7222
7223         Converter := TbmpBitfieldFormat.Create;
7224         Converter.RedMask   := dwRBitMask;
7225         Converter.GreenMask := dwGBitMask;
7226         Converter.BlueMask  := dwBBitMask;
7227         Converter.AlphaMask := dwABitMask;
7228         Converter.PixelSize := dwRGBBitCount / 8;
7229       end;
7230     end;
7231   end;
7232
7233 var
7234   StreamPos: Int64;
7235   x, y, LineSize, RowSize, Magic: Cardinal;
7236   NewImage, TmpData, RowData, SrcData: System.PByte;
7237   SourceMD, DestMD: Pointer;
7238   Pixel: TglBitmapPixelData;
7239   ddsFormat: TglBitmapFormat;
7240   FormatDesc: TFormatDescriptor;
7241
7242 begin
7243   result    := false;
7244   Converter := nil;
7245   StreamPos := aStream.Position;
7246
7247   // Magic
7248   aStream.Read(Magic{%H-}, sizeof(Magic));
7249   if (Magic <> DDS_MAGIC) then begin
7250     aStream.Position := StreamPos;
7251     exit;
7252   end;
7253
7254   //Header
7255   aStream.Read(Header{%H-}, sizeof(Header));
7256   if (Header.dwSize <> SizeOf(Header)) or
7257      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7258         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7259   begin
7260     aStream.Position := StreamPos;
7261     exit;
7262   end;
7263
7264   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7265     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7266
7267   ddsFormat := GetDDSFormat;
7268   try
7269     if (ddsFormat = tfEmpty) then
7270       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7271
7272     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7273     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7274     GetMem(NewImage, Header.dwHeight * LineSize);
7275     try
7276       TmpData := NewImage;
7277
7278       //Converter needed
7279       if Assigned(Converter) then begin
7280         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7281         GetMem(RowData, RowSize);
7282         SourceMD := Converter.CreateMappingData;
7283         DestMD   := FormatDesc.CreateMappingData;
7284         try
7285           for y := 0 to Header.dwHeight-1 do begin
7286             TmpData := NewImage + y * LineSize;
7287             SrcData := RowData;
7288             aStream.Read(SrcData^, RowSize);
7289             for x := 0 to Header.dwWidth-1 do begin
7290               Converter.Unmap(SrcData, Pixel, SourceMD);
7291               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7292               FormatDesc.Map(Pixel, TmpData, DestMD);
7293             end;
7294           end;
7295         finally
7296           Converter.FreeMappingData(SourceMD);
7297           FormatDesc.FreeMappingData(DestMD);
7298           FreeMem(RowData);
7299         end;
7300       end else
7301
7302       // Compressed
7303       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7304         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7305         for Y := 0 to Header.dwHeight-1 do begin
7306           aStream.Read(TmpData^, RowSize);
7307           Inc(TmpData, LineSize);
7308         end;
7309       end else
7310
7311       // Uncompressed
7312       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7313         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7314         for Y := 0 to Header.dwHeight-1 do begin
7315           aStream.Read(TmpData^, RowSize);
7316           Inc(TmpData, LineSize);
7317         end;
7318       end else
7319         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7320
7321       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7322       result := true;
7323     except
7324       FreeMem(NewImage);
7325       raise;
7326     end;
7327   finally
7328     FreeAndNil(Converter);
7329   end;
7330 end;
7331
7332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7333 procedure TglBitmap.SaveDDS(const aStream: TStream);
7334 var
7335   Header: TDDSHeader;
7336   FormatDesc: TFormatDescriptor;
7337 begin
7338   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7339     raise EglBitmapUnsupportedFormat.Create('SaveDDS');
7340
7341   FormatDesc := TFormatDescriptor.Get(Format);
7342
7343   // Generell
7344   FillChar(Header{%H-}, SizeOf(Header), 0);
7345   Header.dwSize  := SizeOf(Header);
7346   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7347
7348   Header.dwWidth  := Max(1, Width);
7349   Header.dwHeight := Max(1, Height);
7350
7351   // Caps
7352   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7353
7354   // Pixelformat
7355   Header.PixelFormat.dwSize := sizeof(Header);
7356   if (FormatDesc.IsCompressed) then begin
7357     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7358     case Format of
7359       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7360       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7361       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7362     end;
7363   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7364     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7365     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7366     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7367   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7368     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7369     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7370     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7371     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7372   end else begin
7373     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7374     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7375     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7376     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7377     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7378     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7379   end;
7380
7381   if (FormatDesc.HasAlpha) then
7382     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7383
7384   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7385   aStream.Write(Header, SizeOf(Header));
7386   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7387 end;
7388
7389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7390 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7392 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7393 begin
7394   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7395     result := fLines[aIndex]
7396   else
7397     result := nil;
7398 end;
7399
7400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7401 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7402   const aWidth: Integer; const aHeight: Integer);
7403 var
7404   Idx, LineWidth: Integer;
7405 begin
7406   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7407
7408   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7409     (* TODO PixelFuncs
7410     fGetPixelFunc := GetPixel2DUnmap;
7411     fSetPixelFunc := SetPixel2DUnmap;
7412     *)
7413     // Assigning Data
7414     if Assigned(Data) then begin
7415       SetLength(fLines, GetHeight);
7416       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7417
7418       for Idx := 0 to GetHeight -1 do begin
7419         fLines[Idx] := Data;
7420         Inc(fLines[Idx], Idx * LineWidth);
7421       end;
7422     end
7423       else SetLength(fLines, 0);
7424   end else begin
7425     SetLength(fLines, 0);
7426     (*
7427     fSetPixelFunc := nil;
7428
7429     case Format of
7430       ifDXT1:
7431         fGetPixelFunc := GetPixel2DDXT1;
7432       ifDXT3:
7433         fGetPixelFunc := GetPixel2DDXT3;
7434       ifDXT5:
7435         fGetPixelFunc := GetPixel2DDXT5;
7436       else
7437         fGetPixelFunc := nil;
7438     end;
7439     *)
7440   end;
7441 end;
7442
7443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7444 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7445 var
7446   FormatDesc: TFormatDescriptor;
7447 begin
7448   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7449
7450   FormatDesc := TFormatDescriptor.Get(Format);
7451   if FormatDesc.IsCompressed then begin
7452     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7453   end else if aBuildWithGlu then begin
7454     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7455       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7456   end else begin
7457     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7458       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7459   end;
7460
7461   // Freigeben
7462   if (FreeDataAfterGenTexture) then
7463     FreeData;
7464 end;
7465
7466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7467 procedure TglBitmap2D.AfterConstruction;
7468 begin
7469   inherited;
7470   Target := GL_TEXTURE_2D;
7471 end;
7472
7473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7474 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7475 var
7476   Temp: pByte;
7477   Size, w, h: Integer;
7478   FormatDesc: TFormatDescriptor;
7479 begin
7480   FormatDesc := TFormatDescriptor.Get(Format);
7481   if FormatDesc.IsCompressed then
7482     raise EglBitmapUnsupportedFormat.Create('TglBitmap2D.GrabScreen');
7483
7484   w    := aRight  - aLeft;
7485   h    := aBottom - aTop;
7486   Size := FormatDesc.GetSize(w, h);
7487   GetMem(Temp, Size);
7488   try
7489     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7490     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7491     SetDataPointer(Temp, Format, w, h);
7492     FlipVert;
7493   except
7494     FreeMem(Temp);
7495     raise;
7496   end;
7497 end;
7498
7499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7500 procedure TglBitmap2D.GetDataFromTexture;
7501 var
7502   Temp: PByte;
7503   TempWidth, TempHeight: Integer;
7504   TempIntFormat: Cardinal;
7505   IntFormat, f: TglBitmapFormat;
7506   FormatDesc: TFormatDescriptor;
7507 begin
7508   Bind;
7509
7510   // Request Data
7511   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7512   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7513   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7514
7515   IntFormat := tfEmpty;
7516   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7517     FormatDesc := TFormatDescriptor.Get(f);
7518     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7519       IntFormat := FormatDesc.Format;
7520       break;
7521     end;
7522   end;
7523
7524   // Getting data from OpenGL
7525   FormatDesc := TFormatDescriptor.Get(IntFormat);
7526   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7527   try
7528     if FormatDesc.IsCompressed then
7529       glGetCompressedTexImage(Target, 0, Temp)
7530     else
7531      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7532     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7533   except
7534     FreeMem(Temp);
7535     raise;
7536   end;
7537 end;
7538
7539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7540 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7541 var
7542   BuildWithGlu, PotTex, TexRec: Boolean;
7543   TexSize: Integer;
7544 begin
7545   if Assigned(Data) then begin
7546     // Check Texture Size
7547     if (aTestTextureSize) then begin
7548       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7549
7550       if ((Height > TexSize) or (Width > TexSize)) then
7551         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7552
7553       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7554       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7555
7556       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7557         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7558     end;
7559
7560     CreateId;
7561     SetupParameters(BuildWithGlu);
7562     UploadData(Target, BuildWithGlu);
7563     glAreTexturesResident(1, @fID, @fIsResident);
7564   end;
7565 end;
7566
7567 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7568 function TglBitmap2D.FlipHorz: Boolean;
7569 var
7570   Col, Row: Integer;
7571   TempDestData, DestData, SourceData: PByte;
7572   ImgSize: Integer;
7573 begin
7574   result := inherited FlipHorz;
7575   if Assigned(Data) then begin
7576     SourceData := Data;
7577     ImgSize := Height * fRowSize;
7578     GetMem(DestData, ImgSize);
7579     try
7580       TempDestData := DestData;
7581       Dec(TempDestData, fRowSize + fPixelSize);
7582       for Row := 0 to Height -1 do begin
7583         Inc(TempDestData, fRowSize * 2);
7584         for Col := 0 to Width -1 do begin
7585           Move(SourceData^, TempDestData^, fPixelSize);
7586           Inc(SourceData, fPixelSize);
7587           Dec(TempDestData, fPixelSize);
7588         end;
7589       end;
7590       SetDataPointer(DestData, Format);
7591       result := true;
7592     except
7593       FreeMem(DestData);
7594       raise;
7595     end;
7596   end;
7597 end;
7598
7599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7600 function TglBitmap2D.FlipVert: Boolean;
7601 var
7602   Row: Integer;
7603   TempDestData, DestData, SourceData: PByte;
7604 begin
7605   result := inherited FlipVert;
7606   if Assigned(Data) then begin
7607     SourceData := Data;
7608     GetMem(DestData, Height * fRowSize);
7609     try
7610       TempDestData := DestData;
7611       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7612       for Row := 0 to Height -1 do begin
7613         Move(SourceData^, TempDestData^, fRowSize);
7614         Dec(TempDestData, fRowSize);
7615         Inc(SourceData, fRowSize);
7616       end;
7617       SetDataPointer(DestData, Format);
7618       result := true;
7619     except
7620       FreeMem(DestData);
7621       raise;
7622     end;
7623   end;
7624 end;
7625
7626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7627 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7629 type
7630   TMatrixItem = record
7631     X, Y: Integer;
7632     W: Single;
7633   end;
7634
7635   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7636   TglBitmapToNormalMapRec = Record
7637     Scale: Single;
7638     Heights: array of Single;
7639     MatrixU : array of TMatrixItem;
7640     MatrixV : array of TMatrixItem;
7641   end;
7642
7643 const
7644   ONE_OVER_255 = 1 / 255;
7645
7646   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7647 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7648 var
7649   Val: Single;
7650 begin
7651   with FuncRec do begin
7652     Val :=
7653       Source.Data.r * LUMINANCE_WEIGHT_R +
7654       Source.Data.g * LUMINANCE_WEIGHT_G +
7655       Source.Data.b * LUMINANCE_WEIGHT_B;
7656     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7657   end;
7658 end;
7659
7660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7661 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7662 begin
7663   with FuncRec do
7664     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7665 end;
7666
7667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7668 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7669 type
7670   TVec = Array[0..2] of Single;
7671 var
7672   Idx: Integer;
7673   du, dv: Double;
7674   Len: Single;
7675   Vec: TVec;
7676
7677   function GetHeight(X, Y: Integer): Single;
7678   begin
7679     with FuncRec do begin
7680       X := Max(0, Min(Size.X -1, X));
7681       Y := Max(0, Min(Size.Y -1, Y));
7682       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7683     end;
7684   end;
7685
7686 begin
7687   with FuncRec do begin
7688     with PglBitmapToNormalMapRec(Args)^ do begin
7689       du := 0;
7690       for Idx := Low(MatrixU) to High(MatrixU) do
7691         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7692
7693       dv := 0;
7694       for Idx := Low(MatrixU) to High(MatrixU) do
7695         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7696
7697       Vec[0] := -du * Scale;
7698       Vec[1] := -dv * Scale;
7699       Vec[2] := 1;
7700     end;
7701
7702     // Normalize
7703     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7704     if Len <> 0 then begin
7705       Vec[0] := Vec[0] * Len;
7706       Vec[1] := Vec[1] * Len;
7707       Vec[2] := Vec[2] * Len;
7708     end;
7709
7710     // Farbe zuweisem
7711     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7712     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7713     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7714   end;
7715 end;
7716
7717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7718 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7719 var
7720   Rec: TglBitmapToNormalMapRec;
7721
7722   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7723   begin
7724     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7725       Matrix[Index].X := X;
7726       Matrix[Index].Y := Y;
7727       Matrix[Index].W := W;
7728     end;
7729   end;
7730
7731 begin
7732   (* TODO Compression
7733   if not FormatIsUncompressed(InternalFormat) then
7734     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
7735     *)
7736
7737   if aScale > 100 then
7738     Rec.Scale := 100
7739   else if aScale < -100 then
7740     Rec.Scale := -100
7741   else
7742     Rec.Scale := aScale;
7743
7744   SetLength(Rec.Heights, Width * Height);
7745   try
7746     case aFunc of
7747       nm4Samples: begin
7748         SetLength(Rec.MatrixU, 2);
7749         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7750         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7751
7752         SetLength(Rec.MatrixV, 2);
7753         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7754         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7755       end;
7756
7757       nmSobel: begin
7758         SetLength(Rec.MatrixU, 6);
7759         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7760         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7761         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7762         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7763         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7764         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7765
7766         SetLength(Rec.MatrixV, 6);
7767         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7768         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7769         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7770         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7771         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7772         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7773       end;
7774
7775       nm3x3: begin
7776         SetLength(Rec.MatrixU, 6);
7777         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7778         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7779         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7780         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7781         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7782         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7783
7784         SetLength(Rec.MatrixV, 6);
7785         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7786         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7787         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7788         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7789         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7790         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7791       end;
7792
7793       nm5x5: begin
7794         SetLength(Rec.MatrixU, 20);
7795         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7796         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7797         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7798         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7799         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7800         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7801         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7802         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7803         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7804         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7805         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7806         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7807         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7808         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7809         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7810         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7811         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7812         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7813         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7814         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7815
7816         SetLength(Rec.MatrixV, 20);
7817         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7818         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7819         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7820         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7821         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7822         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7823         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7824         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7825         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7826         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7827         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7828         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7829         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7830         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7831         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7832         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7833         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7834         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7835         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7836         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7837       end;
7838     end;
7839
7840     // Daten Sammeln
7841     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7842       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7843     else
7844       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7845     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7846   finally
7847     SetLength(Rec.Heights, 0);
7848   end;
7849 end;
7850
7851
7852
7853
7854
7855
7856
7857
7858
7859 (*
7860 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7861 var
7862   pTemp: pByte;
7863   Size: Integer;
7864 begin
7865   if Height > 1 then begin
7866     // extract first line of the data
7867     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7868     GetMem(pTemp, Size);
7869
7870     Move(Data^, pTemp^, Size);
7871
7872     FreeMem(Data);
7873   end else
7874     pTemp := Data;
7875
7876   // set data pointer
7877   inherited SetDataPointer(pTemp, Format, Width);
7878
7879   if FormatIsUncompressed(Format) then begin
7880     fUnmapFunc := FormatGetUnMapFunc(Format);
7881     fGetPixelFunc := GetPixel1DUnmap;
7882   end;
7883 end;
7884
7885
7886 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7887 var
7888   pTemp: pByte;
7889 begin
7890   pTemp := Data;
7891   Inc(pTemp, Pos.X * fPixelSize);
7892
7893   fUnmapFunc(pTemp, Pixel);
7894 end;
7895
7896
7897 function TglBitmap1D.FlipHorz: Boolean;
7898 var
7899   Col: Integer;
7900   pTempDest, pDest, pSource: pByte;
7901 begin
7902   result := inherited FlipHorz;
7903
7904   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7905     pSource := Data;
7906
7907     GetMem(pDest, fRowSize);
7908     try
7909       pTempDest := pDest;
7910
7911       Inc(pTempDest, fRowSize);
7912       for Col := 0 to Width -1 do begin
7913         Move(pSource^, pTempDest^, fPixelSize);
7914
7915         Inc(pSource, fPixelSize);
7916         Dec(pTempDest, fPixelSize);
7917       end;
7918
7919       SetDataPointer(pDest, InternalFormat);
7920
7921       result := true;
7922     finally
7923       FreeMem(pDest);
7924     end;
7925   end;
7926 end;
7927
7928
7929 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7930 begin
7931   // Upload data
7932   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7933     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7934   else
7935
7936   // Upload data
7937   if BuildWithGlu then
7938     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
7939   else
7940     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
7941
7942   // Freigeben
7943   if (FreeDataAfterGenTexture) then
7944     FreeData;
7945 end;
7946
7947
7948 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
7949 var
7950   BuildWithGlu, TexRec: Boolean;
7951   glFormat, glInternalFormat, glType: Cardinal;
7952   TexSize: Integer;
7953 begin
7954   if Assigned(Data) then begin
7955     // Check Texture Size
7956     if (TestTextureSize) then begin
7957       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7958
7959       if (Width > TexSize) then
7960         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7961
7962       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7963                 (Target = GL_TEXTURE_RECTANGLE_ARB);
7964
7965       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7966         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7967     end;
7968
7969     CreateId;
7970
7971     SetupParameters(BuildWithGlu);
7972     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7973
7974     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
7975
7976     // Infos sammeln
7977     glAreTexturesResident(1, @fID, @fIsResident);
7978   end;
7979 end;
7980
7981
7982 procedure TglBitmap1D.AfterConstruction;
7983 begin
7984   inherited;
7985
7986   Target := GL_TEXTURE_1D;
7987 end;
7988
7989
7990 { TglBitmapCubeMap }
7991
7992 procedure TglBitmapCubeMap.AfterConstruction;
7993 begin
7994   inherited;
7995
7996   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
7997     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
7998
7999   SetWrap; // set all to GL_CLAMP_TO_EDGE
8000   Target := GL_TEXTURE_CUBE_MAP;
8001   fGenMode := GL_REFLECTION_MAP;
8002 end;
8003
8004
8005 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8006 begin
8007   inherited Bind (EnableTextureUnit);
8008
8009   if EnableTexCoordsGen then begin
8010     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8011     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8012     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8013     glEnable(GL_TEXTURE_GEN_S);
8014     glEnable(GL_TEXTURE_GEN_T);
8015     glEnable(GL_TEXTURE_GEN_R);
8016   end;
8017 end;
8018
8019
8020 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8021 var
8022   glFormat, glInternalFormat, glType: Cardinal;
8023   BuildWithGlu: Boolean;
8024   TexSize: Integer;
8025 begin
8026   // Check Texture Size
8027   if (TestTextureSize) then begin
8028     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8029
8030     if ((Height > TexSize) or (Width > TexSize)) then
8031       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8032
8033     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8034       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8035   end;
8036
8037   // create Texture
8038   if ID = 0 then begin
8039     CreateID;
8040     SetupParameters(BuildWithGlu);
8041   end;
8042
8043   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8044
8045   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8046 end;
8047
8048
8049 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8050 begin
8051   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8052 end;
8053
8054
8055 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8056   DisableTextureUnit: Boolean);
8057 begin
8058   inherited Unbind (DisableTextureUnit);
8059
8060   if DisableTexCoordsGen then begin
8061     glDisable(GL_TEXTURE_GEN_S);
8062     glDisable(GL_TEXTURE_GEN_T);
8063     glDisable(GL_TEXTURE_GEN_R);
8064   end;
8065 end;
8066
8067
8068 { TglBitmapNormalMap }
8069
8070 type
8071   TVec = Array[0..2] of Single;
8072   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8073
8074   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8075   TglBitmapNormalMapRec = record
8076     HalfSize : Integer;
8077     Func: TglBitmapNormalMapGetVectorFunc;
8078   end;
8079
8080
8081 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8082 begin
8083   Vec[0] := HalfSize;
8084   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8085   Vec[2] := - (Position.X + 0.5 - HalfSize);
8086 end;
8087
8088
8089 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8090 begin
8091   Vec[0] := - HalfSize;
8092   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8093   Vec[2] := Position.X + 0.5 - HalfSize;
8094 end;
8095
8096
8097 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8098 begin
8099   Vec[0] := Position.X + 0.5 - HalfSize;
8100   Vec[1] := HalfSize;
8101   Vec[2] := Position.Y + 0.5 - HalfSize;
8102 end;
8103
8104
8105 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8106 begin
8107   Vec[0] := Position.X + 0.5 - HalfSize;
8108   Vec[1] := - HalfSize;
8109   Vec[2] := - (Position.Y + 0.5 - HalfSize);
8110 end;
8111
8112
8113 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8114 begin
8115   Vec[0] := Position.X + 0.5 - HalfSize;
8116   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8117   Vec[2] := HalfSize;
8118 end;
8119
8120
8121 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8122 begin
8123   Vec[0] := - (Position.X + 0.5 - HalfSize);
8124   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8125   Vec[2] := - HalfSize;
8126 end;
8127
8128
8129 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8130 var
8131   Vec : TVec;
8132   Len: Single;
8133 begin
8134   with FuncRec do begin
8135     with PglBitmapNormalMapRec (CustomData)^ do begin
8136       Func(Vec, Position, HalfSize);
8137
8138       // Normalize
8139       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8140       if Len <> 0 then begin
8141         Vec[0] := Vec[0] * Len;
8142         Vec[1] := Vec[1] * Len;
8143         Vec[2] := Vec[2] * Len;
8144       end;
8145
8146       // Scale Vector and AddVectro
8147       Vec[0] := Vec[0] * 0.5 + 0.5;
8148       Vec[1] := Vec[1] * 0.5 + 0.5;
8149       Vec[2] := Vec[2] * 0.5 + 0.5;
8150     end;
8151
8152     // Set Color
8153     Dest.Red   := Round(Vec[0] * 255);
8154     Dest.Green := Round(Vec[1] * 255);
8155     Dest.Blue  := Round(Vec[2] * 255);
8156   end;
8157 end;
8158
8159
8160 procedure TglBitmapNormalMap.AfterConstruction;
8161 begin
8162   inherited;
8163
8164   fGenMode := GL_NORMAL_MAP;
8165 end;
8166
8167
8168 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8169   TestTextureSize: Boolean);
8170 var
8171   Rec: TglBitmapNormalMapRec;
8172   SizeRec: TglBitmapPixelPosition;
8173 begin
8174   Rec.HalfSize := Size div 2;
8175
8176   FreeDataAfterGenTexture := false;
8177
8178   SizeRec.Fields := [ffX, ffY];
8179   SizeRec.X := Size;
8180   SizeRec.Y := Size;
8181
8182   // Positive X
8183   Rec.Func := glBitmapNormalMapPosX;
8184   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8185   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8186
8187   // Negative X
8188   Rec.Func := glBitmapNormalMapNegX;
8189   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8190   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8191
8192   // Positive Y
8193   Rec.Func := glBitmapNormalMapPosY;
8194   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8195   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8196
8197   // Negative Y
8198   Rec.Func := glBitmapNormalMapNegY;
8199   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8200   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8201
8202   // Positive Z
8203   Rec.Func := glBitmapNormalMapPosZ;
8204   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8205   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8206
8207   // Negative Z
8208   Rec.Func := glBitmapNormalMapNegZ;
8209   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8210   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8211 end;
8212 *)
8213
8214 initialization
8215   glBitmapSetDefaultFormat(tfEmpty);
8216   glBitmapSetDefaultMipmap(mmMipmap);
8217   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8218   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8219
8220   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8221   glBitmapSetDefaultDeleteTextureOnFree    (true);
8222
8223   TFormatDescriptor.Init;
8224
8225 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8226   OpenGLInitialized := false;
8227   InitOpenGLCS := TCriticalSection.Create;
8228 {$ENDIF}
8229
8230 finalization
8231   TFormatDescriptor.Finalize;
8232
8233 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8234   FreeAndNil(InitOpenGLCS);
8235 {$ENDIF}
8236
8237 end.
8238