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 // ###### Start of preferences ################################################
 222
 223 {$DEFINE GLB_NO_NATIVE_GL}
 224 // To enable the dglOpenGL.pas Header
 225 // With native GL then bindings are staticlly declared to support other headers
 226 // or use the glBitmap inside of DLLs (minimize codesize).
 227
 228
 229 {.$DEFINE GLB_SDL}
 230 // To enable the support for SDL_surfaces
 231
 232 {.$DEFINE GLB_DELPHI}
 233 // To enable the support for TBitmap from Delphi (not lazarus)
 234
 235
 236 // *** image libs ***
 237
 238 {.$DEFINE GLB_SDL_IMAGE}
 239 // To enable the support of SDL_image to load files. (READ ONLY)
 240 // If you enable SDL_image all other libraries will be ignored!
 241
 242
 243 {.$DEFINE GLB_PNGIMAGE}
 244 // 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
 247 {.$DEFINE GLB_LIB_PNG}
 248 // 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
 252 {.$DEFINE GLB_DELPHI_JPEG}
 253 // if you enable delphi jpegs the libJPEG will be ignored
 254
 255 {.$DEFINE GLB_LIB_JPEG}
 256 // to 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
 260 // ###### End of preferences ##################################################
 261
 262
 263 // ###### PRIVATE. Do not change anything. ####################################
 264 // *** old defines for compatibility ***
 265 {$IFDEF NO_NATIVE_GL}
 266   {$DEFINE GLB_NO_NATIVE_GL}
 267 {$ENDIF}
 268 {$IFDEF pngimage}
 269   {$definde GLB_PNGIMAGE}
 270 {$ENDIF}
 271
 272 // *** Delphi Versions ***
 273 {$IFDEF fpc}
 274   {$MODE Delphi}
 275
 276   {$IFDEF CPUI386}
 277     {$DEFINE CPU386}
 278     {$ASMMODE INTEL}
 279   {$ENDIF}
 280
 281   {$IFNDEF WINDOWS}
 282     {$linklib c}
 283   {$ENDIF}
 284 {$ENDIF}
 285
 286 // *** checking define combinations ***
 287 {$IFDEF GLB_SDL_IMAGE}
 288   {$IFNDEF GLB_SDL}
 289     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 290     {$DEFINE GLB_SDL}
 291   {$ENDIF}
 292   {$IFDEF GLB_PNGIMAGE}
 293     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 294     {$undef GLB_PNGIMAGE}
 295   {$ENDIF}
 296   {$IFDEF GLB_DELPHI_JPEG}
 297     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 298     {$undef GLB_DELPHI_JPEG}
 299   {$ENDIF}
 300   {$IFDEF GLB_LIB_PNG}
 301     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 302     {$undef GLB_LIB_PNG}
 303   {$ENDIF}
 304   {$IFDEF GLB_LIB_JPEG}
 305     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 306     {$undef GLB_LIB_JPEG}
 307   {$ENDIF}
 308
 309   {$DEFINE GLB_SUPPORT_PNG_READ}
 310   {$DEFINE GLB_SUPPORT_JPEG_READ}
 311 {$ENDIF}
 312
 313 {$IFDEF GLB_PNGIMAGE}
 314   {$IFDEF GLB_LIB_PNG}
 315     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 316     {$undef GLB_LIB_PNG}
 317   {$ENDIF}
 318
 319   {$DEFINE GLB_SUPPORT_PNG_READ}
 320   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 321 {$ENDIF}
 322
 323 {$IFDEF GLB_LIB_PNG}
 324   {$DEFINE GLB_SUPPORT_PNG_READ}
 325   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 326 {$ENDIF}
 327
 328 {$IFDEF GLB_DELPHI_JPEG}
 329   {$IFDEF GLB_LIB_JPEG}
 330     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 331     {$undef GLB_LIB_JPEG}
 332   {$ENDIF}
 333
 334   {$DEFINE GLB_SUPPORT_JPEG_READ}
 335   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 336 {$ENDIF}
 337
 338 {$IFDEF GLB_LIB_JPEG}
 339   {$DEFINE GLB_SUPPORT_JPEG_READ}
 340   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 341 {$ENDIF}
 342
 343 // *** general options ***
 344 {$EXTENDEDSYNTAX ON}
 345 {$LONGSTRINGS ON}
 346 {$ALIGN ON}
 347 {$IFNDEF FPC}
 348   {$OPTIMIZATION ON}
 349 {$ENDIF}
 350
 351 interface
 352
 353 uses
 354   {$IFDEF GLB_NO_NATIVE_GL} dglOpenGL,                            {$ENDIF}
 355
 356   {$IFDEF GLB_SDL}          SDL,                                  {$ENDIF}
 357   {$IFDEF GLB_DELPHI}       Dialogs, Windows, Graphics,           {$ENDIF}
 358
 359   {$IFDEF GLB_SDL_IMAGE}    SDL_image,                            {$ENDIF}
 360
 361   {$IFDEF GLB_PNGIMAGE}     pngimage,                             {$ENDIF}
 362   {$IFDEF GLB_LIB_PNG}      libPNG,                               {$ENDIF}
 363
 364   {$IFDEF GLB_DELPHI_JPEG}  JPEG,                                 {$ENDIF}
 365   {$IFDEF GLB_LIB_JPEG}     libJPEG,                              {$ENDIF}
 366   Classes, SysUtils;
 367
 368 {$IFNDEF GLB_DELPHI}
 369 type
 370   HGLRC = Cardinal;
 371   DWORD = Cardinal;
 372   PDWORD = ^DWORD;
 373
 374   TRGBQuad = packed record
 375     rgbBlue: Byte;
 376     rgbGreen: Byte;
 377     rgbRed: Byte;
 378     rgbReserved: Byte;
 379   end;
 380 {$ENDIF}
 381
 382 (* TODO dglOpenGL
 383 {$IFNDEF GLB_NO_NATIVE_GL}
 384 // Native OpenGL Implementation
 385 type
 386   PByteBool = ^ByteBool;
 387
 388 {$IFDEF GLB_DELPHI}
 389 var
 390   gLastContext: HGLRC;
 391 {$ENDIF}
 392
 393 const
 394   // Generell
 395   GL_VERSION = $1F02;
 396   GL_EXTENSIONS = $1F03;
 397
 398   GL_TRUE = 1;
 399   GL_FALSE = 0;
 400
 401   GL_TEXTURE_1D = $0DE0;
 402   GL_TEXTURE_2D = $0DE1;
 403
 404   GL_MAX_TEXTURE_SIZE = $0D33;
 405   GL_PACK_ALIGNMENT = $0D05;
 406   GL_UNPACK_ALIGNMENT = $0CF5;
 407
 408   // Textureformats
 409   GL_RGB = $1907;
 410   GL_RGB4 = $804F;
 411   GL_RGB8 = $8051;
 412   GL_RGBA = $1908;
 413   GL_RGBA4 = $8056;
 414   GL_RGBA8 = $8058;
 415   GL_BGR = $80E0;
 416   GL_BGRA = $80E1;
 417   GL_ALPHA4 = $803B;
 418   GL_ALPHA8 = $803C;
 419   GL_LUMINANCE4 = $803F;
 420   GL_LUMINANCE8 = $8040;
 421   GL_LUMINANCE4_ALPHA4 = $8043;
 422   GL_LUMINANCE8_ALPHA8 = $8045;
 423   GL_DEPTH_COMPONENT = $1902;
 424
 425   GL_UNSIGNED_BYTE = $1401;
 426   GL_ALPHA = $1906;
 427   GL_LUMINANCE = $1909;
 428   GL_LUMINANCE_ALPHA = $190A;
 429
 430   GL_TEXTURE_WIDTH = $1000;
 431   GL_TEXTURE_HEIGHT = $1001;
 432   GL_TEXTURE_INTERNAL_FORMAT = $1003;
 433   GL_TEXTURE_RED_SIZE = $805C;
 434   GL_TEXTURE_GREEN_SIZE = $805D;
 435   GL_TEXTURE_BLUE_SIZE = $805E;
 436   GL_TEXTURE_ALPHA_SIZE = $805F;
 437   GL_TEXTURE_LUMINANCE_SIZE = $8060;
 438
 439   // Dataformats
 440   GL_UNSIGNED_SHORT_5_6_5 = $8363;
 441   GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
 442   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 443   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 444   GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
 445
 446   // Filter
 447   GL_NEAREST = $2600;
 448   GL_LINEAR = $2601;
 449   GL_NEAREST_MIPMAP_NEAREST = $2700;
 450   GL_LINEAR_MIPMAP_NEAREST = $2701;
 451   GL_NEAREST_MIPMAP_LINEAR = $2702;
 452   GL_LINEAR_MIPMAP_LINEAR = $2703;
 453   GL_TEXTURE_MAG_FILTER = $2800;
 454   GL_TEXTURE_MIN_FILTER = $2801;
 455
 456   // Wrapmodes
 457   GL_TEXTURE_WRAP_S = $2802;
 458   GL_TEXTURE_WRAP_T = $2803;
 459   GL_CLAMP = $2900;
 460   GL_REPEAT = $2901;
 461   GL_CLAMP_TO_EDGE = $812F;
 462   GL_CLAMP_TO_BORDER = $812D;
 463   GL_TEXTURE_WRAP_R = $8072;
 464
 465   GL_MIRRORED_REPEAT = $8370;
 466
 467   // Border Color
 468   GL_TEXTURE_BORDER_COLOR = $1004;
 469
 470   // Texgen
 471   GL_NORMAL_MAP = $8511;
 472   GL_REFLECTION_MAP = $8512;
 473   GL_S = $2000;
 474   GL_T = $2001;
 475   GL_R = $2002;
 476   GL_TEXTURE_GEN_MODE = $2500;
 477   GL_TEXTURE_GEN_S = $0C60;
 478   GL_TEXTURE_GEN_T = $0C61;
 479   GL_TEXTURE_GEN_R = $0C62;
 480
 481   // Cubemaps
 482   GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
 483   GL_TEXTURE_CUBE_MAP = $8513;
 484   GL_TEXTURE_BINDING_CUBE_MAP = $8514;
 485   GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
 486   GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
 487   GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
 488   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
 489   GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
 490   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
 491
 492   GL_TEXTURE_RECTANGLE_ARB = $84F5;
 493
 494   // GL_SGIS_generate_mipmap
 495   GL_GENERATE_MIPMAP = $8191;
 496
 497   // GL_EXT_texture_compression_s3tc
 498   GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
 499   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
 500   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
 501   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
 502
 503   // GL_EXT_texture_filter_anisotropic
 504   GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
 505   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 506
 507   // GL_ARB_texture_compression
 508   GL_COMPRESSED_RGB = $84ED;
 509   GL_COMPRESSED_RGBA = $84EE;
 510   GL_COMPRESSED_ALPHA = $84E9;
 511   GL_COMPRESSED_LUMINANCE = $84EA;
 512   GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;
 513
 514   // Extensions
 515 var
 516   GL_VERSION_1_2,
 517   GL_VERSION_1_3,
 518   GL_VERSION_1_4,
 519   GL_VERSION_2_0,
 520
 521   GL_ARB_texture_border_clamp,
 522   GL_ARB_texture_cube_map,
 523   GL_ARB_texture_compression,
 524   GL_ARB_texture_non_power_of_two,
 525   GL_ARB_texture_rectangle,
 526   GL_ARB_texture_mirrored_repeat,
 527   GL_EXT_bgra,
 528   GL_EXT_texture_edge_clamp,
 529   GL_EXT_texture_cube_map,
 530   GL_EXT_texture_compression_s3tc,
 531   GL_EXT_texture_filter_anisotropic,
 532   GL_EXT_texture_rectangle,
 533   GL_NV_texture_rectangle,
 534   GL_IBM_texture_mirrored_repeat,
 535   GL_SGIS_generate_mipmap: Boolean;
 536
 537 const
 538 {$IFDEF LINUX}
 539   libglu = 'libGLU.so.1';
 540   libopengl = 'libGL.so.1';
 541 {$else}
 542   libglu = 'glu32.dll';
 543   libopengl = 'opengl32.dll';
 544 {$ENDIF}
 545
 546 {$IFDEF LINUX}
 547   function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl;
 548 {$else}
 549   function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl;
 550 {$ENDIF}
 551
 552   function glGetString(name: Cardinal): PAnsiChar; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 553
 554   procedure glEnable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 555   procedure glDisable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 556   procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 557
 558   procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 559   procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 560
 561   procedure glGenTextures(n: Integer; Textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 562   procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 563   procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 564
 565   procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 566   procedure glPixelStorei(pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 567   procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 568
 569   function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool;  {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 570   procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 571   procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 572   procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 573   procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 574
 575   function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
 576   function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
 577
 578 var
 579   glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 580   glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 581   glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 582 {$ENDIF}
 583 *)
 584
 585 type
 586 ////////////////////////////////////////////////////////////////////////////////////////////////////
 587   EglBitmapException               = class(Exception);
 588   EglBitmapSizeToLargeException    = class(EglBitmapException);
 589   EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 590   EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
 591
 592 ////////////////////////////////////////////////////////////////////////////////////////////////////
 593   TglBitmapFormat = (
 594     tfEmpty = 0,
 595
 596     tfAlpha4,
 597     tfAlpha8,
 598     tfAlpha12,
 599     tfAlpha16,
 600
 601     tfLuminance4,
 602     tfLuminance8,
 603     tfLuminance12,
 604     tfLuminance16,
 605
 606     tfLuminance4Alpha4,
 607     tfLuminance6Alpha2,
 608     tfLuminance8Alpha8,
 609     tfLuminance12Alpha4,
 610     tfLuminance12Alpha12,
 611     tfLuminance16Alpha16,
 612
 613     tfR3G3B2,
 614     tfRGB4,
 615     tfR5G6B5,
 616     tfRGB5,
 617     tfRGB8,
 618     tfRGB10,
 619     tfRGB12,
 620     tfRGB16,
 621
 622     tfRGBA2,
 623     tfRGBA4,
 624     tfRGB5A1,
 625     tfRGBA8,
 626     tfRGB10A2,
 627     tfRGBA12,
 628     tfRGBA16,
 629
 630     tfBGR4,
 631     tfB5G6R5,
 632     tfBGR5,
 633     tfBGR8,
 634     tfBGR10,
 635     tfBGR12,
 636     tfBGR16,
 637
 638     tfBGRA2,
 639     tfBGRA4,
 640     tfBGR5A1,
 641     tfBGRA8,
 642     tfBGR10A2,
 643     tfBGRA12,
 644     tfBGRA16,
 645
 646     tfDepth16,
 647     tfDepth24,
 648     tfDepth32
 649   );
 650
 651   TglBitmapFileType = (
 652      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 653      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 654      ftDDS,
 655      ftTGA,
 656      ftBMP);
 657    TglBitmapFileTypes = set of TglBitmapFileType;
 658
 659    TglBitmapMipMap = (
 660      mmNone,
 661      mmMipmap,
 662      mmMipmapGlu);
 663
 664    TglBitmapNormalMapFunc = (
 665      nm4Samples,
 666      nmSobel,
 667      nm3x3,
 668      nm5x5);
 669
 670 ////////////////////////////////////////////////////////////////////////////////////////////////////
 671   TglBitmapColorRec = packed record
 672   case Integer of
 673     0: (r, g, b, a: Cardinal);
 674     1: (arr: array[0..3] of Cardinal);
 675   end;
 676
 677   TglBitmapPixelData = packed record
 678     Data, Range: TglBitmapColorRec;
 679     Format: TglBitmapFormat;
 680   end;
 681   PglBitmapPixelData = ^TglBitmapPixelData;
 682
 683 ////////////////////////////////////////////////////////////////////////////////////////////////////
 684   TglBitmapPixelPositionFields = set of (ffX, ffY);
 685   TglBitmapPixelPosition = record
 686     Fields : TglBitmapPixelPositionFields;
 687     X : Word;
 688     Y : Word;
 689   end;
 690
 691 ////////////////////////////////////////////////////////////////////////////////////////////////////
 692   TglBitmap = class;
 693   TglBitmapFunctionRec = record
 694     Sender:   TglBitmap;
 695     Size:     TglBitmapPixelPosition;
 696     Position: TglBitmapPixelPosition;
 697     Source:   TglBitmapPixelData;
 698     Dest:     TglBitmapPixelData;
 699     Args:     PtrInt;
 700   end;
 701   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 702
 703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 704   TglBitmap = class
 705   protected
 706     fID: GLuint;
 707     fTarget: GLuint;
 708     fAnisotropic: Integer;
 709     fDeleteTextureOnFree: Boolean;
 710     fFreeDataAfterGenTexture: Boolean;
 711     fData: PByte;
 712     fIsResident: Boolean;
 713     fBorderColor: array[0..3] of Single;
 714
 715     fDimension: TglBitmapPixelPosition;
 716     fMipMap: TglBitmapMipMap;
 717     fFormat: TglBitmapFormat;
 718
 719     // Mapping
 720     fPixelSize: Integer;
 721     fRowSize: Integer;
 722
 723     // Filtering
 724     fFilterMin: Cardinal;
 725     fFilterMag: Cardinal;
 726
 727     // TexturWarp
 728     fWrapS: Cardinal;
 729     fWrapT: Cardinal;
 730     fWrapR: Cardinal;
 731
 732     // CustomData
 733     fFilename: String;
 734     fCustomName: String;
 735     fCustomNameW: WideString;
 736     fCustomData: Pointer;
 737
 738     //Getter
 739     function GetWidth:  Integer; virtual;
 740     function GetHeight: Integer; virtual;
 741
 742     function GetFileWidth:  Integer; virtual;
 743     function GetFileHeight: Integer; virtual;
 744
 745     //Setter
 746     procedure SetCustomData(const aValue: Pointer);
 747     procedure SetCustomName(const aValue: String);
 748     procedure SetCustomNameW(const aValue: WideString);
 749     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 750     procedure SetFormat(const aValue: TglBitmapFormat);
 751     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 752     procedure SetID(const aValue: Cardinal);
 753     procedure SetMipMap(const aValue: TglBitmapMipMap);
 754     procedure SetTarget(const aValue: Cardinal);
 755     procedure SetAnisotropic(const aValue: Integer);
 756
 757     procedure CreateID;
 758     procedure SetupParameters(var aBuildWithGlu: Boolean);
 759     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 760       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 761     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 762
 763     function FlipHorz: Boolean; virtual;
 764     function FlipVert: Boolean; virtual;
 765
 766     property Width:  Integer read GetWidth;
 767     property Height: Integer read GetHeight;
 768
 769     property FileWidth:  Integer read GetFileWidth;
 770     property FileHeight: Integer read GetFileHeight;
 771   public
 772     //Properties
 773     property ID:           Cardinal        read fID          write SetID;
 774     property Target:       Cardinal        read fTarget      write SetTarget;
 775     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 776     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 777     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 778
 779     property Filename:    String     read fFilename;
 780     property CustomName:  String     read fCustomName  write SetCustomName;
 781     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 782     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 783
 784     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 785     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 786
 787     property Dimension:  TglBitmapPixelPosition  read fDimension;
 788     property Data:       PByte                   read fData;
 789     property IsResident: Boolean                 read fIsResident;
 790
 791     procedure AfterConstruction; override;
 792     procedure BeforeDestruction; override;
 793
 794     //Load
 795     procedure LoadFromFile(const aFilename: String);
 796     procedure LoadFromStream(const aStream: TStream); virtual;
 797     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 798       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
 799     {$IFDEF GLB_DELPHI}
 800     procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
 801     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 802     {$ENDIF}
 803
 804     //Save
 805     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 806     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 807
 808     //Convert
 809     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;
 810     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 811       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;
 812   public
 813     //Alpha & Co
 814     {$IFDEF GLB_SDL}
 815     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 816     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 817     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 818     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 819       const aArgs: PtrInt = 0): Boolean;
 820     {$ENDIF}
 821
 822     {$IFDEF GLB_DELPHI}
 823     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 824     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 825     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 826     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 827       const aArgs: PtrInt = 0): Boolean;
 828     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
 829       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 830     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 831       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 832     {$ENDIF}
 833
 834     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
 835     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 836     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 837     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 838
 839     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 840     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 841     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 842
 843     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 844     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 845     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 846
 847     function RemoveAlpha: Boolean; virtual;
 848   public
 849     //Common
 850     function Clone: TglBitmap;
 851     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 852     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 853     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 854     procedure FreeData;
 855
 856     //ColorFill
 857     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 858     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 859     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 860
 861     //TexParameters
 862     procedure SetFilter(const aMin, aMag: Cardinal);
 863     procedure SetWrap(
 864       const S: Cardinal = GL_CLAMP_TO_EDGE;
 865       const T: Cardinal = GL_CLAMP_TO_EDGE;
 866       const R: Cardinal = GL_CLAMP_TO_EDGE);
 867
 868     procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);   virtual;
 869     procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;
 870
 871     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 872     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 873
 874     //Constructors
 875     constructor Create; overload;
 876     constructor Create(const aFileName: String); overload;
 877     constructor Create(const aStream: TStream); overload;
 878     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 879     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;
 880     {$IFDEF GLB_DELPHI}
 881     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 882     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 883     {$ENDIF}
 884   private
 885     {$IFDEF GLB_SUPPORT_PNG_READ}
 886     function LoadPNG(const aStream: TStream): Boolean; virtual;
 887     procedure SavePNG(const aStream: TStream); virtual;
 888     {$ENDIF}
 889     {$IFDEF GLB_SUPPORT_JPEG_READ}
 890     function LoadJPEG(const aStream: TStream): Boolean; virtual;
 891     procedure SaveJPEG(const aStream: TStream); virtual;
 892     {$ENDIF}
 893     function LoadBMP(const aStream: TStream): Boolean; virtual;
 894     procedure SaveBMP(const aStream: TStream); virtual;
 895
 896     function LoadTGA(const aStream: TStream): Boolean; virtual;
 897     procedure SaveTGA(const aStream: TStream); virtual;
 898
 899     function LoadDDS(const aStream: TStream): Boolean; virtual;
 900     procedure SaveDDS(const aStream: TStream); virtual;
 901   end;
 902
 903 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 904   TglBitmap2D = class(TglBitmap)
 905   protected
 906     // Bildeinstellungen
 907     fLines: array of PByte;
 908
 909     (* TODO
 910     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
 911     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 912     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 913     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 914     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 915     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
 916     *)
 917
 918     function GetScanline(const aIndex: Integer): Pointer;
 919     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 920       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
 921     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
 922   public
 923     property Width;
 924     property Height;
 925     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
 926
 927     procedure AfterConstruction; override;
 928
 929     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
 930     procedure GetDataFromTexture;
 931     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
 932
 933     function FlipHorz: Boolean; override;
 934     function FlipVert: Boolean; override;
 935
 936     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 937       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 938   end;
 939
 940 (* TODO
 941   TglBitmapCubeMap = class(TglBitmap2D)
 942   protected
 943     fGenMode: Integer;
 944
 945     // Hide GenTexture
 946     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
 947   public
 948     procedure AfterConstruction; override;
 949
 950     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
 951
 952     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
 953     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
 954   end;
 955
 956
 957   TglBitmapNormalMap = class(TglBitmapCubeMap)
 958   public
 959     procedure AfterConstruction; override;
 960
 961     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
 962   end;
 963
 964
 965   TglBitmap1D = class(TglBitmap)
 966   protected
 967     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 968
 969     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
 970     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
 971   public
 972     // propertys
 973     property Width;
 974
 975     procedure AfterConstruction; override;
 976
 977     // Other
 978     function FlipHorz: Boolean; override;
 979
 980     // Generation
 981     procedure GenTexture(TestTextureSize: Boolean = true); override;
 982   end;
 983 *)
 984
 985 const
 986   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
 987
 988 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
 989 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
 990 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
 991 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
 992 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
 993 procedure glBitmapSetDefaultWrap(
 994   const S: Cardinal = GL_CLAMP_TO_EDGE;
 995   const T: Cardinal = GL_CLAMP_TO_EDGE;
 996   const R: Cardinal = GL_CLAMP_TO_EDGE);
 997
 998 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
 999 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1000 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1001 function glBitmapGetDefaultFormat: TglBitmapFormat;
1002 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1003 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1004
1005 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1006 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1007 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1008
1009 var
1010   glBitmapDefaultDeleteTextureOnFree: Boolean;
1011   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1012   glBitmapDefaultFormat: TglBitmapFormat;
1013   glBitmapDefaultMipmap: TglBitmapMipMap;
1014   glBitmapDefaultFilterMin: Cardinal;
1015   glBitmapDefaultFilterMag: Cardinal;
1016   glBitmapDefaultWrapS: Cardinal;
1017   glBitmapDefaultWrapT: Cardinal;
1018   glBitmapDefaultWrapR: Cardinal;
1019
1020 {$IFDEF GLB_DELPHI}
1021 function CreateGrayPalette: HPALETTE;
1022 {$ENDIF}
1023
1024 implementation
1025
1026
1027     (* TODO
1028     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1029     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1030     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1031     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1032     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1033     *)
1034
1035 uses
1036   Math, syncobjs;
1037
1038 type
1039 ////////////////////////////////////////////////////////////////////////////////////////////////////
1040   TShiftRec = packed record
1041   case Integer of
1042     0: (r, g, b, a: Byte);
1043     1: (arr: array[0..3] of Byte);
1044   end;
1045
1046   TFormatDescriptor = class(TObject)
1047   private
1048     function GetRedMask: UInt64;
1049     function GetGreenMask: UInt64;
1050     function GetBlueMask: UInt64;
1051     function GetAlphaMask: UInt64;
1052   protected
1053     fFormat: TglBitmapFormat;
1054     fWithAlpha: TglBitmapFormat;
1055     fWithoutAlpha: TglBitmapFormat;
1056     fRGBInverted: TglBitmapFormat;
1057     fPixelSize: Single;
1058
1059     fRange: TglBitmapColorRec;
1060     fShift: TShiftRec;
1061
1062     fglFormat:         Cardinal;
1063     fglInternalFormat: Cardinal;
1064     fglDataFormat:     Cardinal;
1065
1066     function GetComponents: Integer; virtual;
1067   public
1068     property Format:       TglBitmapFormat read fFormat;
1069     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1070     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1071     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1072     property Components:   Integer         read GetComponents;
1073     property PixelSize:    Single          read fPixelSize;
1074
1075     property glFormat:         Cardinal read fglFormat;
1076     property glInternalFormat: Cardinal read fglInternalFormat;
1077     property glDataFormat:     Cardinal read fglDataFormat;
1078
1079     property Range: TglBitmapColorRec read fRange;
1080     property Shift: TShiftRec         read fShift;
1081
1082     property RedMask:   UInt64 read GetRedMask;
1083     property GreenMask: UInt64 read GetGreenMask;
1084     property BlueMask:  UInt64 read GetBlueMask;
1085     property AlphaMask: UInt64 read GetAlphaMask;
1086
1087     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1088     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1089
1090     function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1091     function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1092
1093     function CreateMappingData: Pointer; virtual;
1094     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1095
1096     function IsEmpty:  Boolean; virtual;
1097     function HasAlpha: Boolean; virtual;
1098     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
1099
1100     procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual;
1101
1102     constructor Create; virtual;
1103   public
1104     class procedure Init;
1105     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1106     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1107     class procedure Clear;
1108     class procedure Finalize;
1109   end;
1110   TFormatDescriptorClass = class of TFormatDescriptor;
1111
1112   TfdEmpty = class(TFormatDescriptor);
1113
1114 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1115   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1116     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1117     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1118     constructor Create; override;
1119   end;
1120
1121   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1122     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1123     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1124     constructor Create; override;
1125   end;
1126
1127   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1128     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1129     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1130     constructor Create; override;
1131   end;
1132
1133   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1134     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1135     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1136     constructor Create; override;
1137   end;
1138
1139   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1140     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1141     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1142     constructor Create; override;
1143   end;
1144
1145   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1146     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1147     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1148     constructor Create; override;
1149   end;
1150
1151   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1152     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1153     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1154     constructor Create; override;
1155   end;
1156
1157   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1158     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1159     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1160     constructor Create; override;
1161   end;
1162
1163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1164   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1165     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1166     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1167     constructor Create; override;
1168   end;
1169
1170   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1171     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1172     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1173     constructor Create; override;
1174   end;
1175
1176   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1177     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1178     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1179     constructor Create; override;
1180   end;
1181
1182   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1183     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1184     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1185     constructor Create; override;
1186   end;
1187
1188   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1189     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1190     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1191     constructor Create; override;
1192   end;
1193
1194   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1195     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1196     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1197     constructor Create; override;
1198   end;
1199
1200   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1201     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1202     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1203     constructor Create; override;
1204   end;
1205
1206   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1207     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1208     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1209     constructor Create; override;
1210   end;
1211
1212   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1213     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1214     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1215     constructor Create; override;
1216   end;
1217
1218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1219   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1220     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1221     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1222     constructor Create; override;
1223   end;
1224
1225   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1226     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1227     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1228     constructor Create; override;
1229   end;
1230
1231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1232   TfdAlpha4 = class(TfdAlpha_UB1)
1233     constructor Create; override;
1234   end;
1235
1236   TfdAlpha8 = class(TfdAlpha_UB1)
1237     constructor Create; override;
1238   end;
1239
1240   TfdAlpha12 = class(TfdAlpha_US1)
1241     constructor Create; override;
1242   end;
1243
1244   TfdAlpha16 = class(TfdAlpha_US1)
1245     constructor Create; override;
1246   end;
1247
1248   TfdLuminance4 = class(TfdLuminance_UB1)
1249     constructor Create; override;
1250   end;
1251
1252   TfdLuminance8 = class(TfdLuminance_UB1)
1253     constructor Create; override;
1254   end;
1255
1256   TfdLuminance12 = class(TfdLuminance_US1)
1257     constructor Create; override;
1258   end;
1259
1260   TfdLuminance16 = class(TfdLuminance_US1)
1261     constructor Create; override;
1262   end;
1263
1264   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1265     constructor Create; override;
1266   end;
1267
1268   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1269     constructor Create; override;
1270   end;
1271
1272   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1273     constructor Create; override;
1274   end;
1275
1276   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1277     constructor Create; override;
1278   end;
1279
1280   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1281     constructor Create; override;
1282   end;
1283
1284   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1285     constructor Create; override;
1286   end;
1287
1288   TfdR3G3B2 = class(TfdUniversal_UB1)
1289     constructor Create; override;
1290   end;
1291
1292   TfdRGB4 = class(TfdUniversal_US1)
1293     constructor Create; override;
1294   end;
1295
1296   TfdR5G6B5 = class(TfdUniversal_US1)
1297     constructor Create; override;
1298   end;
1299
1300   TfdRGB5 = class(TfdUniversal_US1)
1301     constructor Create; override;
1302   end;
1303
1304   TfdRGB8 = class(TfdRGB_UB3)
1305     constructor Create; override;
1306   end;
1307
1308   TfdRGB10 = class(TfdUniversal_UI1)
1309     constructor Create; override;
1310   end;
1311
1312   TfdRGB12 = class(TfdRGB_US3)
1313     constructor Create; override;
1314   end;
1315
1316   TfdRGB16 = class(TfdRGB_US3)
1317     constructor Create; override;
1318   end;
1319
1320   TfdRGBA2 = class(TfdRGBA_UB4)
1321     constructor Create; override;
1322   end;
1323
1324   TfdRGBA4 = class(TfdUniversal_US1)
1325     constructor Create; override;
1326   end;
1327
1328   TfdRGB5A1 = class(TfdUniversal_US1)
1329     constructor Create; override;
1330   end;
1331
1332   TfdRGBA8 = class(TfdRGBA_UB4)
1333     constructor Create; override;
1334   end;
1335
1336   TfdRGB10A2 = class(TfdUniversal_UI1)
1337     constructor Create; override;
1338   end;
1339
1340   TfdRGBA12 = class(TfdRGBA_US4)
1341     constructor Create; override;
1342   end;
1343
1344   TfdRGBA16 = class(TfdRGBA_US4)
1345     constructor Create; override;
1346   end;
1347
1348   TfdBGR4 = class(TfdUniversal_US1)
1349     constructor Create; override;
1350   end;
1351
1352   TfdB5G6R5 = class(TfdUniversal_US1)
1353     constructor Create; override;
1354   end;
1355
1356   TfdBGR5 = class(TfdUniversal_US1)
1357     constructor Create; override;
1358   end;
1359
1360   TfdBGR8 = class(TfdBGR_UB3)
1361     constructor Create; override;
1362   end;
1363
1364   TfdBGR10 = class(TfdUniversal_UI1)
1365     constructor Create; override;
1366   end;
1367
1368   TfdBGR12 = class(TfdBGR_US3)
1369     constructor Create; override;
1370   end;
1371
1372   TfdBGR16 = class(TfdBGR_US3)
1373     constructor Create; override;
1374   end;
1375
1376   TfdBGRA2 = class(TfdBGRA_UB4)
1377     constructor Create; override;
1378   end;
1379
1380   TfdBGRA4 = class(TfdUniversal_US1)
1381     constructor Create; override;
1382   end;
1383
1384   TfdBGR5A1 = class(TfdUniversal_US1)
1385     constructor Create; override;
1386   end;
1387
1388   TfdBGRA8 = class(TfdBGRA_UB4)
1389     constructor Create; override;
1390   end;
1391
1392   TfdBGR10A2 = class(TfdUniversal_UI1)
1393     constructor Create; override;
1394   end;
1395
1396   TfdBGRA12 = class(TfdBGRA_US4)
1397     constructor Create; override;
1398   end;
1399
1400   TfdBGRA16 = class(TfdBGRA_US4)
1401     constructor Create; override;
1402   end;
1403
1404   TfdDepth16 = class(TfdDepth_US1)
1405     constructor Create; override;
1406   end;
1407
1408   TfdDepth24 = class(TfdDepth_UI1)
1409     constructor Create; override;
1410   end;
1411
1412   TfdDepth32 = class(TfdDepth_UI1)
1413     constructor Create; override;
1414   end;
1415
1416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1417   TbmpBitfieldFormat = class(TFormatDescriptor)
1418   private
1419     procedure SetRedMask  (const aValue: UInt64);
1420     procedure SetGreenMask(const aValue: UInt64);
1421     procedure SetBlueMask (const aValue: UInt64);
1422     procedure SetAlphaMask(const aValue: UInt64);
1423
1424     procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);
1425   public
1426     property RedMask:   UInt64 read GetRedMask   write SetRedMask;
1427     property GreenMask: UInt64 read GetGreenMask write SetGreenMask;
1428     property BlueMask:  UInt64 read GetBlueMask  write SetBlueMask;
1429     property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;
1430
1431     property PixelSize: Single read fPixelSize write fPixelSize;
1432
1433     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1434     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1435   end;
1436
1437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1438   TbmpColorTableEnty = packed record
1439     b, g, r, a: Byte;
1440   end;
1441   TbmpColorTable = array of TbmpColorTableEnty;
1442   TbmpColorTableFormat = class(TFormatDescriptor)
1443   private
1444     fColorTable: TbmpColorTable;
1445   public
1446     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1447     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1448     property Range:      TglBitmapColorRec read fRange      write fRange;
1449     property Shift:      TShiftRec         read fShift      write fShift;
1450     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1451
1452     procedure CreateColorTable;
1453
1454     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1455     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1456     destructor Destroy; override;
1457   end;
1458
1459 const
1460   LUMINANCE_WEIGHT_R = 0.30;
1461   LUMINANCE_WEIGHT_G = 0.59;
1462   LUMINANCE_WEIGHT_B = 0.11;
1463
1464   ALPHA_WEIGHT_R = 0.30;
1465   ALPHA_WEIGHT_G = 0.59;
1466   ALPHA_WEIGHT_B = 0.11;
1467
1468   DEPTH_WEIGHT_R = 0.333333333;
1469   DEPTH_WEIGHT_G = 0.333333333;
1470   DEPTH_WEIGHT_B = 0.333333333;
1471
1472   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1473
1474   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1475     TfdEmpty,
1476
1477     TfdAlpha4,
1478     TfdAlpha8,
1479     TfdAlpha12,
1480     TfdAlpha16,
1481
1482     TfdLuminance4,
1483     TfdLuminance8,
1484     TfdLuminance12,
1485     TfdLuminance16,
1486
1487     TfdLuminance4Alpha4,
1488     TfdLuminance6Alpha2,
1489     TfdLuminance8Alpha8,
1490     TfdLuminance12Alpha4,
1491     TfdLuminance12Alpha12,
1492     TfdLuminance16Alpha16,
1493
1494     TfdR3G3B2,
1495     TfdRGB4,
1496     TfdR5G6B5,
1497     TfdRGB5,
1498     TfdRGB8,
1499     TfdRGB10,
1500     TfdRGB12,
1501     TfdRGB16,
1502
1503     TfdRGBA2,
1504     TfdRGBA4,
1505     TfdRGB5A1,
1506     TfdRGBA8,
1507     TfdRGB10A2,
1508     TfdRGBA12,
1509     TfdRGBA16,
1510
1511     TfdBGR4,
1512     TfdB5G6R5,
1513     TfdBGR5,
1514     TfdBGR8,
1515     TfdBGR10,
1516     TfdBGR12,
1517     TfdBGR16,
1518
1519     TfdBGRA2,
1520     TfdBGRA4,
1521     TfdBGR5A1,
1522     TfdBGRA8,
1523     TfdBGR10A2,
1524     TfdBGRA12,
1525     TfdBGRA16,
1526
1527     TfdDepth16,
1528     TfdDepth24,
1529     TfdDepth32
1530   );
1531
1532 var
1533   FormatDescriptorCS: TCriticalSection;
1534   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1535
1536 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1537 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1538 begin
1539   result.Fields := [];
1540
1541   if X >= 0 then
1542     result.Fields := result.Fields + [ffX];
1543   if Y >= 0 then
1544     result.Fields := result.Fields + [ffY];
1545
1546   result.X := Max(0, X);
1547   result.Y := Max(0, Y);
1548 end;
1549
1550 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1551 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1552 begin
1553   result.r := r;
1554   result.g := g;
1555   result.b := b;
1556   result.a := a;
1557 end;
1558
1559 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1560 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1561 var
1562   i: Integer;
1563 begin
1564   result := false;
1565   for i := 0 to high(r1.arr) do
1566     if (r1.arr[i] <> r2.arr[i]) then
1567       exit;
1568   result := true;
1569 end;
1570
1571 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1572 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1573 begin
1574   result.r := r;
1575   result.g := g;
1576   result.b := b;
1577   result.a := a;
1578 end;
1579
1580 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1581 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1582 begin
1583   result := [ftDDS];
1584
1585   if (aFormat in [
1586         //4 bbp
1587         tfLuminance4,
1588
1589         //8bpp
1590         tfR3G3B2, tfLuminance8,
1591
1592         //16bpp
1593         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1594         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1595
1596         //24bpp
1597         tfBGR8, tfRGB8,
1598
1599         //32bpp
1600         tfRGB10, tfRGB10A2, tfRGBA8,
1601         tfBGR10, tfBGR10A2, tfBGRA8]) then
1602     result := result + [ftBMP];
1603
1604   if (aFormat in [
1605         //8 bpp
1606         tfLuminance8, tfAlpha8,
1607
1608         //16 bpp
1609         tfLuminance16, tfLuminance8Alpha8,
1610         tfRGB5, tfRGB5A1, tfRGBA4,
1611         tfBGR5, tfBGR5A1, tfBGRA4,
1612
1613         //24 bpp
1614         tfRGB8, tfBGR8,
1615
1616         //32 bpp
1617         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1618     result := result + [ftTGA];
1619
1620   //TODO Supported File Formats!
1621
1622   (*
1623   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1624   if aFormat in [
1625     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1626     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1627     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1628     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1629     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1630     tfDepth16, tfDepth24, tfDepth32]
1631   then
1632     result := result + [ftPNG];
1633   {$ENDIF}
1634
1635   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1636   if Format in [
1637     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1638     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1639     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1640     tfDepth16, tfDepth24, tfDepth32]
1641   then
1642     result := result + [ftJPEG];
1643   {$ENDIF}
1644
1645   if aFormat in [
1646     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1647     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1648     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1649     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1650     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1651     tfDepth16, tfDepth24, tfDepth32]
1652   then
1653     result := result + [ftDDS, ftTGA, ftBMP];
1654   *)
1655 end;
1656
1657 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1658 function IsPowerOfTwo(aNumber: Integer): Boolean;
1659 begin
1660   while (aNumber and 1) = 0 do
1661     aNumber := aNumber shr 1;
1662   result := aNumber = 1;
1663 end;
1664
1665 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1666 function GetTopMostBit(aBitSet: UInt64): Integer;
1667 begin
1668   result := 0;
1669   while aBitSet > 0 do begin
1670     inc(result);
1671     aBitSet := aBitSet shr 1;
1672   end;
1673 end;
1674
1675 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1676 function CountSetBits(aBitSet: UInt64): Integer;
1677 begin
1678   result := 0;
1679   while aBitSet > 0 do begin
1680     if (aBitSet and 1) = 1 then
1681       inc(result);
1682     aBitSet := aBitSet shr 1;
1683   end;
1684 end;
1685
1686 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1687 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1688 begin
1689   result := Trunc(
1690     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1691     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1692     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1693 end;
1694
1695 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1696 begin
1697   result := Trunc(
1698     DEPTH_WEIGHT_R * aPixel.Data.r +
1699     DEPTH_WEIGHT_G * aPixel.Data.g +
1700     DEPTH_WEIGHT_B * aPixel.Data.b);
1701 end;
1702
1703 //TODO check _ARB functions and constants
1704
1705 (* GLB_NO_NATIVE_GL
1706 {$IFNDEF GLB_NO_NATIVE_GL}
1707 procedure ReadOpenGLExtensions;
1708 var
1709   {$IFDEF GLB_DELPHI}
1710   Context: HGLRC;
1711   {$ENDIF}
1712   Buffer: AnsiString;
1713   MajorVersion, MinorVersion: Integer;
1714
1715
1716   procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
1717   var
1718     Separator: Integer;
1719   begin
1720     Minor := 0;
1721     Major := 0;
1722
1723     Separator := Pos(AnsiString('.'), Buffer);
1724
1725     if (Separator > 1) and (Separator < Length(Buffer)) and
1726        (Buffer[Separator - 1] in ['0'..'9']) and
1727        (Buffer[Separator + 1] in ['0'..'9']) then begin
1728
1729       Dec(Separator);
1730       while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
1731         Dec(Separator);
1732
1733       Delete(Buffer, 1, Separator);
1734       Separator := Pos(AnsiString('.'), Buffer) + 1;
1735
1736       while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
1737         Inc(Separator);
1738
1739       Delete(Buffer, Separator, 255);
1740       Separator := Pos(AnsiString('.'), Buffer);
1741
1742       Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
1743       Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
1744     end;
1745   end;
1746
1747
1748   function CheckExtension(const Extension: AnsiString): Boolean;
1749   var
1750     ExtPos: Integer;
1751   begin
1752     ExtPos := Pos(Extension, Buffer);
1753     result := ExtPos > 0;
1754
1755     if result then
1756       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1757   end;
1758
1759
1760   function glLoad (aFunc: pAnsiChar): pointer;
1761   begin
1762     {$IFDEF LINUX}
1763       result := glXGetProcAddress(aFunc);
1764     {$else}
1765       result := wglGetProcAddress(aFunc);
1766     {$ENDIF}
1767   end;
1768
1769
1770 begin
1771   {$IFDEF GLB_DELPHI}
1772   Context := wglGetCurrentContext;
1773
1774   if Context <> gLastContext then begin
1775     gLastContext := Context;
1776   {$ENDIF}
1777
1778     // Version
1779     Buffer := glGetString(GL_VERSION);
1780     TrimVersionString(Buffer, MajorVersion, MinorVersion);
1781
1782     GL_VERSION_1_2 := false;
1783     GL_VERSION_1_3 := false;
1784     GL_VERSION_1_4 := false;
1785     GL_VERSION_2_0 := false;
1786
1787     if MajorVersion = 1 then begin
1788       if MinorVersion >= 1 then begin
1789         if MinorVersion >= 2 then
1790           GL_VERSION_1_2 := true;
1791
1792         if MinorVersion >= 3 then
1793           GL_VERSION_1_3 := true;
1794
1795         if MinorVersion >= 4 then
1796           GL_VERSION_1_4 := true;
1797       end;
1798     end;
1799
1800     if MajorVersion >= 2 then begin
1801       GL_VERSION_1_2 := true;
1802       GL_VERSION_1_3 := true;
1803       GL_VERSION_1_4 := true;
1804       GL_VERSION_2_0 := true;
1805     end;
1806
1807     // Extensions
1808     Buffer := glGetString(GL_EXTENSIONS);
1809     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
1810     GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
1811     GL_ARB_texture_compression        := CheckExtension('GL_ARB_texture_compression');
1812     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
1813     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
1814     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
1815     GL_EXT_bgra                       := CheckExtension('GL_EXT_bgra');
1816     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
1817     GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
1818     GL_EXT_texture_compression_s3tc   := CheckExtension('GL_EXT_texture_compression_s3tc');
1819     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
1820     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
1821     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
1822     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
1823     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
1824
1825     // Funtions
1826     if GL_VERSION_1_3 then begin
1827       // Loading Core
1828       glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
1829       glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
1830       glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
1831     end else
1832
1833     begin
1834       // Try loading Extension
1835       glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
1836       glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
1837       glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
1838     end;
1839   {$IFDEF GLB_DELPHI}
1840   end;
1841   {$ENDIF}
1842 end;
1843 {$ENDIF}
1844 *)
1845
1846 (* TODO GLB_DELPHI
1847 {$IFDEF GLB_DELPHI}
1848 function CreateGrayPalette: HPALETTE;
1849 var
1850   Idx: Integer;
1851   Pal: PLogPalette;
1852 begin
1853   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
1854
1855   Pal.palVersion := $300;
1856   Pal.palNumEntries := 256;
1857
1858   {$IFOPT R+}
1859     {$DEFINE GLB_TEMPRANGECHECK}
1860     {$R-}
1861   {$ENDIF}
1862
1863   for Idx := 0 to 256 - 1 do begin
1864     Pal.palPalEntry[Idx].peRed   := Idx;
1865     Pal.palPalEntry[Idx].peGreen := Idx;
1866     Pal.palPalEntry[Idx].peBlue  := Idx;
1867     Pal.palPalEntry[Idx].peFlags := 0;
1868   end;
1869
1870   {$IFDEF GLB_TEMPRANGECHECK}
1871     {$UNDEF GLB_TEMPRANGECHECK}
1872     {$R+}
1873   {$ENDIF}
1874
1875   result := CreatePalette(Pal^);
1876
1877   FreeMem(Pal);
1878 end;
1879 {$ENDIF}
1880 *)
1881
1882 (* TODO GLB_SDL_IMAGE
1883 {$IFDEF GLB_SDL_IMAGE}
1884 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
1885 begin
1886   result := TStream(context^.unknown.data1).Seek(offset, whence);
1887 end;
1888
1889 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
1890 begin
1891   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
1892 end;
1893
1894 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
1895 begin
1896   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
1897 end;
1898
1899 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
1900 begin
1901   result := 0;
1902 end;
1903
1904 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
1905 begin
1906   result := SDL_AllocRW;
1907
1908   if result = nil then
1909     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
1910
1911   result^.seek := glBitmapRWseek;
1912   result^.read := glBitmapRWread;
1913   result^.write := glBitmapRWwrite;
1914   result^.close := glBitmapRWclose;
1915   result^.unknown.data1 := Stream;
1916 end;
1917 {$ENDIF}
1918 *)
1919
1920 (* TODO LoadFuncs
1921 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
1922 var
1923   glBitmap: TglBitmap2D;
1924 begin
1925   result := false;
1926   Texture := 0;
1927
1928   {$IFDEF GLB_DELPHI}
1929   if Instance = 0 then
1930     Instance := HInstance;
1931
1932   if (LoadFromRes) then
1933     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
1934   else
1935   {$ENDIF}
1936     glBitmap := TglBitmap2D.Create(FileName);
1937
1938   try
1939     glBitmap.DeleteTextureOnFree := false;
1940     glBitmap.FreeDataAfterGenTexture := false;
1941     glBitmap.GenTexture(true);
1942     if (glBitmap.ID > 0) then begin
1943       Texture := glBitmap.ID;
1944       result := true;
1945     end;
1946   finally
1947     glBitmap.Free;
1948   end;
1949 end;
1950
1951 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
1952 var
1953   CM: TglBitmapCubeMap;
1954 begin
1955   Texture := 0;
1956
1957   {$IFDEF GLB_DELPHI}
1958   if Instance = 0 then
1959     Instance := HInstance;
1960   {$ENDIF}
1961
1962   CM := TglBitmapCubeMap.Create;
1963   try
1964     CM.DeleteTextureOnFree := false;
1965
1966     // Maps
1967     {$IFDEF GLB_DELPHI}
1968     if (LoadFromRes) then
1969       CM.LoadFromResource(Instance, PositiveX)
1970     else
1971     {$ENDIF}
1972       CM.LoadFromFile(PositiveX);
1973     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
1974
1975     {$IFDEF GLB_DELPHI}
1976     if (LoadFromRes) then
1977       CM.LoadFromResource(Instance, NegativeX)
1978     else
1979     {$ENDIF}
1980       CM.LoadFromFile(NegativeX);
1981     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
1982
1983     {$IFDEF GLB_DELPHI}
1984     if (LoadFromRes) then
1985       CM.LoadFromResource(Instance, PositiveY)
1986     else
1987     {$ENDIF}
1988       CM.LoadFromFile(PositiveY);
1989     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
1990
1991     {$IFDEF GLB_DELPHI}
1992     if (LoadFromRes) then
1993       CM.LoadFromResource(Instance, NegativeY)
1994     else
1995     {$ENDIF}
1996       CM.LoadFromFile(NegativeY);
1997     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
1998
1999     {$IFDEF GLB_DELPHI}
2000     if (LoadFromRes) then
2001       CM.LoadFromResource(Instance, PositiveZ)
2002     else
2003     {$ENDIF}
2004       CM.LoadFromFile(PositiveZ);
2005     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2006
2007     {$IFDEF GLB_DELPHI}
2008     if (LoadFromRes) then
2009       CM.LoadFromResource(Instance, NegativeZ)
2010     else
2011     {$ENDIF}
2012       CM.LoadFromFile(NegativeZ);
2013     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2014
2015     Texture := CM.ID;
2016     result := true;
2017   finally
2018     CM.Free;
2019   end;
2020 end;
2021
2022 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2023 var
2024   NM: TglBitmapNormalMap;
2025 begin
2026   Texture := 0;
2027
2028   NM := TglBitmapNormalMap.Create;
2029   try
2030     NM.DeleteTextureOnFree := false;
2031     NM.GenerateNormalMap(Size);
2032
2033     Texture := NM.ID;
2034     result := true;
2035   finally
2036     NM.Free;
2037   end;
2038 end;
2039 *)
2040
2041 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2042 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2043 begin
2044   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2045 end;
2046
2047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2048 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2049 begin
2050   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2051 end;
2052
2053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2054 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2055 begin
2056   glBitmapDefaultMipmap := aValue;
2057 end;
2058
2059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2060 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2061 begin
2062   glBitmapDefaultFormat := aFormat;
2063 end;
2064
2065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2066 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2067 begin
2068   glBitmapDefaultFilterMin := aMin;
2069   glBitmapDefaultFilterMag := aMag;
2070 end;
2071
2072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2073 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2074 begin
2075   glBitmapDefaultWrapS := S;
2076   glBitmapDefaultWrapT := T;
2077   glBitmapDefaultWrapR := R;
2078 end;
2079
2080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2081 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2082 begin
2083   result := glBitmapDefaultDeleteTextureOnFree;
2084 end;
2085
2086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2087 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2088 begin
2089   result := glBitmapDefaultFreeDataAfterGenTextures;
2090 end;
2091
2092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2093 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2094 begin
2095   result := glBitmapDefaultMipmap;
2096 end;
2097
2098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2099 function glBitmapGetDefaultFormat: TglBitmapFormat;
2100 begin
2101   result := glBitmapDefaultFormat;
2102 end;
2103
2104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2105 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2106 begin
2107   aMin := glBitmapDefaultFilterMin;
2108   aMag := glBitmapDefaultFilterMag;
2109 end;
2110
2111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2112 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2113 begin
2114   S := glBitmapDefaultWrapS;
2115   T := glBitmapDefaultWrapT;
2116   R := glBitmapDefaultWrapR;
2117 end;
2118
2119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2120 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2122 function TFormatDescriptor.GetRedMask: UInt64;
2123 begin
2124   result := fRange.r shl fShift.r;
2125 end;
2126
2127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2128 function TFormatDescriptor.GetGreenMask: UInt64;
2129 begin
2130   result := fRange.g shl fShift.g;
2131 end;
2132
2133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2134 function TFormatDescriptor.GetBlueMask: UInt64;
2135 begin
2136   result := fRange.b shl fShift.b;
2137 end;
2138
2139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2140 function TFormatDescriptor.GetAlphaMask: UInt64;
2141 begin
2142   result := fRange.a shl fShift.a;
2143 end;
2144
2145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2146 function TFormatDescriptor.GetComponents: Integer;
2147 var
2148   i: Integer;
2149 begin
2150   result := 0;
2151   for i := 0 to 3 do
2152     if (fRange.arr[i] > 0) then
2153       inc(result);
2154 end;
2155
2156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2157 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2158 var
2159   w, h: Integer;
2160 begin
2161   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2162     w := Max(1, aSize.X);
2163     h := Max(1, aSize.Y);
2164     result := GetSize(w, h);
2165   end else
2166     result := 0;
2167 end;
2168
2169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2170 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2171 begin
2172   result := 0;
2173   if (aWidth <= 0) or (aHeight <= 0) then
2174     exit;
2175   result := Ceil(aWidth * aHeight * fPixelSize);
2176 end;
2177
2178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2179 function TFormatDescriptor.CreateMappingData: Pointer;
2180 begin
2181   result := nil;
2182 end;
2183
2184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2185 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2186 begin
2187   //DUMMY
2188 end;
2189
2190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2191 function TFormatDescriptor.IsEmpty: Boolean;
2192 begin
2193   result := (fFormat = tfEmpty);
2194 end;
2195
2196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2197 function TFormatDescriptor.HasAlpha: Boolean;
2198 begin
2199   result := (fRange.a > 0);
2200 end;
2201
2202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2203 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
2204 begin
2205   result := false;
2206
2207   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2208     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2209
2210   if (aRedMask   <> RedMask) then
2211     exit;
2212   if (aGreenMask <> GreenMask) then
2213     exit;
2214   if (aBlueMask  <> BlueMask) then
2215     exit;
2216   if (aAlphaMask <> AlphaMask) then
2217     exit;
2218   result := true;
2219 end;
2220
2221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2222 procedure TFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);
2223 begin
2224   FillChar(aPixel, SizeOf(aPixel), 0);
2225   aPixel.Data   := fRange;
2226   aPixel.Range  := fRange;
2227   aPixel.Format := fFormat;
2228 end;
2229
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 constructor TFormatDescriptor.Create;
2232 begin
2233   inherited Create;
2234
2235   fFormat       := tfEmpty;
2236   fWithAlpha    := tfEmpty;
2237   fWithoutAlpha := tfEmpty;
2238   fRGBInverted  := tfEmpty;
2239   fPixelSize    := 0.0;
2240
2241   fglFormat         := 0;
2242   fglInternalFormat := 0;
2243   fglDataFormat     := 0;
2244
2245   FillChar(fRange, 0, SizeOf(fRange));
2246   FillChar(fShift, 0, SizeOf(fShift));
2247 end;
2248
2249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2250 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2252 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2253 begin
2254   aData^ := aPixel.Data.a;
2255   inc(aData);
2256 end;
2257
2258 procedure TfdAlpha_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2259 begin
2260   aPixel.Data.r := 0;
2261   aPixel.Data.g := 0;
2262   aPixel.Data.b := 0;
2263   aPixel.Data.a := aData^;
2264   inc(aData^);
2265 end;
2266
2267 constructor TfdAlpha_UB1.Create;
2268 begin
2269   inherited Create;
2270   fPixelSize        := 1.0;
2271   fRange.a          := $FF;
2272   fglFormat         := GL_ALPHA;
2273   fglDataFormat     := GL_UNSIGNED_BYTE;
2274 end;
2275
2276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2277 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2280 begin
2281   aData^ := LuminanceWeight(aPixel);
2282   inc(aData);
2283 end;
2284
2285 procedure TfdLuminance_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2286 begin
2287   aPixel.Data.r := aData^;
2288   aPixel.Data.g := aData^;
2289   aPixel.Data.b := aData^;
2290   aPixel.Data.a := 0;
2291   inc(aData);
2292 end;
2293
2294 constructor TfdLuminance_UB1.Create;
2295 begin
2296   inherited Create;
2297   fPixelSize        := 1.0;
2298   fRange.r          := $FF;
2299   fRange.g          := $FF;
2300   fRange.b          := $FF;
2301   fglFormat         := GL_LUMINANCE;
2302   fglDataFormat     := GL_UNSIGNED_BYTE;
2303 end;
2304
2305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2306 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2308 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2309 var
2310   i: Integer;
2311 begin
2312   aData^ := 0;
2313   for i := 0 to 3 do
2314     if (fRange.arr[i] > 0) then
2315       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2316   inc(aData);
2317 end;
2318
2319 procedure TfdUniversal_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2320 var
2321   i: Integer;
2322 begin
2323   for i := 0 to 3 do
2324     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2325   inc(aData);
2326 end;
2327
2328 constructor TfdUniversal_UB1.Create;
2329 begin
2330   inherited Create;
2331   fPixelSize := 1.0;
2332 end;
2333
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2337 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2338 begin
2339   inherited Map(aPixel, aData, aMapData);
2340   aData^ := aPixel.Data.a;
2341   inc(aData);
2342 end;
2343
2344 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2345 begin
2346   inherited Unmap(aData, aPixel, aMapData);
2347   aPixel.Data.a := aData^;
2348   inc(aData);
2349 end;
2350
2351 constructor TfdLuminanceAlpha_UB2.Create;
2352 begin
2353   inherited Create;
2354   fPixelSize        := 2.0;
2355   fRange.a          := $FF;
2356   fShift.a          :=   8;
2357   fglFormat         := GL_LUMINANCE_ALPHA;
2358   fglDataFormat     := GL_UNSIGNED_BYTE;
2359 end;
2360
2361 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2362 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2364 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2365 begin
2366   aData^ := aPixel.Data.r;
2367   inc(aData);
2368   aData^ := aPixel.Data.g;
2369   inc(aData);
2370   aData^ := aPixel.Data.b;
2371   inc(aData);
2372 end;
2373
2374 procedure TfdRGB_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2375 begin
2376   aPixel.Data.r := aData^;
2377   inc(aData);
2378   aPixel.Data.g := aData^;
2379   inc(aData);
2380   aPixel.Data.b := aData^;
2381   inc(aData);
2382   aPixel.Data.a := 0;
2383 end;
2384
2385 constructor TfdRGB_UB3.Create;
2386 begin
2387   inherited Create;
2388   fPixelSize        := 3.0;
2389   fRange.r          := $FF;
2390   fRange.g          := $FF;
2391   fRange.b          := $FF;
2392   fShift.r          :=   0;
2393   fShift.g          :=   8;
2394   fShift.b          :=  16;
2395   fglFormat         := GL_RGB;
2396   fglDataFormat     := GL_UNSIGNED_BYTE;
2397 end;
2398
2399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2400 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2402 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2403 begin
2404   aData^ := aPixel.Data.b;
2405   inc(aData);
2406   aData^ := aPixel.Data.g;
2407   inc(aData);
2408   aData^ := aPixel.Data.r;
2409   inc(aData);
2410 end;
2411
2412 procedure TfdBGR_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2413 begin
2414   aPixel.Data.b := aData^;
2415   inc(aData);
2416   aPixel.Data.g := aData^;
2417   inc(aData);
2418   aPixel.Data.r := aData^;
2419   inc(aData);
2420   aPixel.Data.a := 0;
2421 end;
2422
2423 constructor TfdBGR_UB3.Create;
2424 begin
2425   fPixelSize        := 3.0;
2426   fRange.r          := $FF;
2427   fRange.g          := $FF;
2428   fRange.b          := $FF;
2429   fShift.r          :=  16;
2430   fShift.g          :=   8;
2431   fShift.b          :=   0;
2432   fglFormat         := GL_BGR;
2433   fglDataFormat     := GL_UNSIGNED_BYTE;
2434 end;
2435
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2439 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2440 begin
2441   inherited Map(aPixel, aData, aMapData);
2442   aData^ := aPixel.Data.a;
2443   inc(aData);
2444 end;
2445
2446 procedure TfdRGBA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2447 begin
2448   inherited Unmap(aData, aPixel, aMapData);
2449   aPixel.Data.a := aData^;
2450   inc(aData);
2451 end;
2452
2453 constructor TfdRGBA_UB4.Create;
2454 begin
2455   inherited Create;
2456   fPixelSize        := 4.0;
2457   fRange.a          := $FF;
2458   fShift.a          :=  24;
2459   fglFormat         := GL_RGBA;
2460   fglDataFormat     := GL_UNSIGNED_BYTE;
2461 end;
2462
2463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2466 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2467 begin
2468   inherited Map(aPixel, aData, aMapData);
2469   aData^ := aPixel.Data.a;
2470   inc(aData);
2471 end;
2472
2473 procedure TfdBGRA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2474 begin
2475   inherited Unmap(aData, aPixel, aMapData);
2476   aPixel.Data.a := aData^;
2477   inc(aData);
2478 end;
2479
2480 constructor TfdBGRA_UB4.Create;
2481 begin
2482   inherited Create;
2483   fPixelSize        := 4.0;
2484   fRange.a          := $FF;
2485   fShift.a          :=  24;
2486   fglFormat         := GL_BGRA;
2487   fglDataFormat     := GL_UNSIGNED_BYTE;
2488 end;
2489
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2494 begin
2495   PWord(aData)^ := aPixel.Data.a;
2496   inc(aData, 2);
2497 end;
2498
2499 procedure TfdAlpha_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2500 begin
2501   aPixel.Data.r := 0;
2502   aPixel.Data.g := 0;
2503   aPixel.Data.b := 0;
2504   aPixel.Data.a := PWord(aData)^;
2505   inc(aData, 2);
2506 end;
2507
2508 constructor TfdAlpha_US1.Create;
2509 begin
2510   inherited Create;
2511   fPixelSize        := 2.0;
2512   fRange.a          := $FFFF;
2513   fglFormat         := GL_ALPHA;
2514   fglDataFormat     := GL_UNSIGNED_SHORT;
2515 end;
2516
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2521 begin
2522   PWord(aData)^ := LuminanceWeight(aPixel);
2523   inc(aData, 2);
2524 end;
2525
2526 procedure TfdLuminance_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2527 begin
2528   aPixel.Data.r := PWord(aData)^;
2529   aPixel.Data.g := PWord(aData)^;
2530   aPixel.Data.b := PWord(aData)^;
2531   aPixel.Data.a := 0;
2532   inc(aData, 2);
2533 end;
2534
2535 constructor TfdLuminance_US1.Create;
2536 begin
2537   inherited Create;
2538   fPixelSize        := 2.0;
2539   fRange.r          := $FFFF;
2540   fRange.g          := $FFFF;
2541   fRange.b          := $FFFF;
2542   fglFormat         := GL_LUMINANCE;
2543   fglDataFormat     := GL_UNSIGNED_SHORT;
2544 end;
2545
2546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2550 var
2551   i: Integer;
2552 begin
2553   PWord(aData)^ := 0;
2554   for i := 0 to 3 do
2555     if (fRange.arr[i] > 0) then
2556       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2557   inc(aData, 2);
2558 end;
2559
2560 procedure TfdUniversal_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2561 var
2562   i: Integer;
2563 begin
2564   for i := 0 to 3 do
2565     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2566   inc(aData, 2);
2567 end;
2568
2569 constructor TfdUniversal_US1.Create;
2570 begin
2571   inherited Create;
2572   fPixelSize := 2.0;
2573 end;
2574
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2579 begin
2580   PWord(aData)^ := DepthWeight(aPixel);
2581   inc(aData, 2);
2582 end;
2583
2584 procedure TfdDepth_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2585 begin
2586   aPixel.Data.r := PWord(aData)^;
2587   aPixel.Data.g := PWord(aData)^;
2588   aPixel.Data.b := PWord(aData)^;
2589   aPixel.Data.a := 0;
2590   inc(aData, 2);
2591 end;
2592
2593 constructor TfdDepth_US1.Create;
2594 begin
2595   inherited Create;
2596   fPixelSize        := 2.0;
2597   fRange.r          := $FFFF;
2598   fRange.g          := $FFFF;
2599   fRange.b          := $FFFF;
2600   fglFormat         := GL_DEPTH_COMPONENT;
2601   fglDataFormat     := GL_UNSIGNED_SHORT;
2602 end;
2603
2604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2607 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2608 begin
2609   inherited Map(aPixel, aData, aMapData);
2610   PWord(aData)^ := aPixel.Data.a;
2611   inc(aData, 2);
2612 end;
2613
2614 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2615 begin
2616   inherited Unmap(aData, aPixel, aMapData);
2617   aPixel.Data.a := PWord(aData)^;
2618   inc(aData, 2);
2619 end;
2620
2621 constructor TfdLuminanceAlpha_US2.Create;
2622 begin
2623   inherited Create;
2624   fPixelSize        :=   4.0;
2625   fRange.a          := $FFFF;
2626   fShift.a          :=    16;
2627   fglFormat         := GL_LUMINANCE_ALPHA;
2628   fglDataFormat     := GL_UNSIGNED_SHORT;
2629 end;
2630
2631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2632 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2634 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2635 begin
2636   PWord(aData)^ := aPixel.Data.r;
2637   inc(aData, 2);
2638   PWord(aData)^ := aPixel.Data.g;
2639   inc(aData, 2);
2640   PWord(aData)^ := aPixel.Data.b;
2641   inc(aData, 2);
2642 end;
2643
2644 procedure TfdRGB_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2645 begin
2646   aPixel.Data.r := PWord(aData)^;
2647   inc(aData, 2);
2648   aPixel.Data.g := PWord(aData)^;
2649   inc(aData, 2);
2650   aPixel.Data.b := PWord(aData)^;
2651   inc(aData, 2);
2652   aPixel.Data.a := 0;
2653 end;
2654
2655 constructor TfdRGB_US3.Create;
2656 begin
2657   inherited Create;
2658   fPixelSize        :=   6.0;
2659   fRange.r          := $FFFF;
2660   fRange.g          := $FFFF;
2661   fRange.b          := $FFFF;
2662   fShift.r          :=     0;
2663   fShift.g          :=    16;
2664   fShift.b          :=    32;
2665   fglFormat         := GL_RGB;
2666   fglDataFormat     := GL_UNSIGNED_SHORT;
2667 end;
2668
2669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2670 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2672 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2673 begin
2674   PWord(aData)^ := aPixel.Data.b;
2675   inc(aData, 2);
2676   PWord(aData)^ := aPixel.Data.g;
2677   inc(aData, 2);
2678   PWord(aData)^ := aPixel.Data.r;
2679   inc(aData, 2);
2680 end;
2681
2682 procedure TfdBGR_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2683 begin
2684   aPixel.Data.b := PWord(aData)^;
2685   inc(aData, 2);
2686   aPixel.Data.g := PWord(aData)^;
2687   inc(aData, 2);
2688   aPixel.Data.r := PWord(aData)^;
2689   inc(aData, 2);
2690   aPixel.Data.a := 0;
2691 end;
2692
2693 constructor TfdBGR_US3.Create;
2694 begin
2695   inherited Create;
2696   fPixelSize        :=   6.0;
2697   fRange.r          := $FFFF;
2698   fRange.g          := $FFFF;
2699   fRange.b          := $FFFF;
2700   fShift.r          :=    32;
2701   fShift.g          :=    16;
2702   fShift.b          :=     0;
2703   fglFormat         := GL_BGR;
2704   fglDataFormat     := GL_UNSIGNED_SHORT;
2705 end;
2706
2707 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2708 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2709 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2710 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2711 begin
2712   inherited Map(aPixel, aData, aMapData);
2713   PWord(aData)^ := aPixel.Data.a;
2714   inc(aData, 2);
2715 end;
2716
2717 procedure TfdRGBA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2718 begin
2719   inherited Unmap(aData, aPixel, aMapData);
2720   aPixel.Data.a := PWord(aData)^;
2721   inc(aData, 2);
2722 end;
2723
2724 constructor TfdRGBA_US4.Create;
2725 begin
2726   inherited Create;
2727   fPixelSize        :=   8.0;
2728   fRange.a          := $FFFF;
2729   fShift.a          :=    48;
2730   fglFormat         := GL_RGBA;
2731   fglDataFormat     := GL_UNSIGNED_SHORT;
2732 end;
2733
2734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2735 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2737 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2738 begin
2739   inherited Map(aPixel, aData, aMapData);
2740   PWord(aData)^ := aPixel.Data.a;
2741   inc(aData, 2);
2742 end;
2743
2744 procedure TfdBGRA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2745 begin
2746   inherited Unmap(aData, aPixel, aMapData);
2747   aPixel.Data.a := PWord(aData)^;
2748   inc(aData, 2);
2749 end;
2750
2751 constructor TfdBGRA_US4.Create;
2752 begin
2753   inherited Create;
2754   fPixelSize        :=   8.0;
2755   fRange.a          := $FFFF;
2756   fShift.a          :=    48;
2757   fglFormat         := GL_BGRA;
2758   fglDataFormat     := GL_UNSIGNED_SHORT;
2759 end;
2760
2761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2764 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2765 var
2766   i: Integer;
2767 begin
2768   PCardinal(aData)^ := 0;
2769   for i := 0 to 3 do
2770     if (fRange.arr[i] > 0) then
2771       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2772   inc(aData, 4);
2773 end;
2774
2775 procedure TfdUniversal_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2776 var
2777   i: Integer;
2778 begin
2779   for i := 0 to 3 do
2780     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2781   inc(aData, 2);
2782 end;
2783
2784 constructor TfdUniversal_UI1.Create;
2785 begin
2786   inherited Create;
2787   fPixelSize := 4.0;
2788 end;
2789
2790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2793 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2794 begin
2795   PCardinal(aData)^ := DepthWeight(aPixel);
2796   inc(aData, 4);
2797 end;
2798
2799 procedure TfdDepth_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2800 begin
2801   aPixel.Data.r := PCardinal(aData)^;
2802   aPixel.Data.g := PCardinal(aData)^;
2803   aPixel.Data.b := PCardinal(aData)^;
2804   aPixel.Data.a := 0;
2805   inc(aData, 4);
2806 end;
2807
2808 constructor TfdDepth_UI1.Create;
2809 begin
2810   inherited Create;
2811   fPixelSize        := 4.0;
2812   fRange.r          := $FFFFFFFF;
2813   fRange.g          := $FFFFFFFF;
2814   fRange.b          := $FFFFFFFF;
2815   fglFormat         := GL_DEPTH_COMPONENT;
2816   fglDataFormat     := GL_UNSIGNED_INT;
2817 end;
2818
2819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2822 constructor TfdAlpha4.Create;
2823 begin
2824   inherited Create;
2825   fFormat           := tfAlpha4;
2826   fWithAlpha        := tfAlpha4;
2827   fglInternalFormat := GL_ALPHA4;
2828 end;
2829
2830 constructor TfdAlpha8.Create;
2831 begin
2832   inherited Create;
2833   fFormat           := tfAlpha8;
2834   fWithAlpha        := tfAlpha8;
2835   fglInternalFormat := GL_ALPHA8;
2836 end;
2837
2838 constructor TfdAlpha12.Create;
2839 begin
2840   inherited Create;
2841   fFormat           := tfAlpha12;
2842   fWithAlpha        := tfAlpha12;
2843   fglInternalFormat := GL_ALPHA12;
2844 end;
2845
2846 constructor TfdAlpha16.Create;
2847 begin
2848   inherited Create;
2849   fFormat           := tfAlpha16;
2850   fWithAlpha        := tfAlpha16;
2851   fglInternalFormat := GL_ALPHA16;
2852 end;
2853
2854 constructor TfdLuminance4.Create;
2855 begin
2856   inherited Create;
2857   fFormat           := tfLuminance4;
2858   fWithAlpha        := tfLuminance4Alpha4;
2859   fWithoutAlpha     := tfLuminance4;
2860   fglInternalFormat := GL_LUMINANCE4;
2861 end;
2862
2863 constructor TfdLuminance8.Create;
2864 begin
2865   inherited Create;
2866   fFormat           := tfLuminance8;
2867   fWithAlpha        := tfLuminance8Alpha8;
2868   fWithoutAlpha     := tfLuminance8;
2869   fglInternalFormat := GL_LUMINANCE8;
2870 end;
2871
2872 constructor TfdLuminance12.Create;
2873 begin
2874   inherited Create;
2875   fFormat           := tfLuminance12;
2876   fWithAlpha        := tfLuminance12Alpha12;
2877   fWithoutAlpha     := tfLuminance12;
2878   fglInternalFormat := GL_LUMINANCE12;
2879 end;
2880
2881 constructor TfdLuminance16.Create;
2882 begin
2883   inherited Create;
2884   fFormat           := tfLuminance16;
2885   fWithAlpha        := tfLuminance16Alpha16;
2886   fWithoutAlpha     := tfLuminance16;
2887   fglInternalFormat := GL_LUMINANCE16;
2888 end;
2889
2890 constructor TfdLuminance4Alpha4.Create;
2891 begin
2892   inherited Create;
2893   fFormat           := tfLuminance4Alpha4;
2894   fWithAlpha        := tfLuminance4Alpha4;
2895   fWithoutAlpha     := tfLuminance4;
2896   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2897 end;
2898
2899 constructor TfdLuminance6Alpha2.Create;
2900 begin
2901   inherited Create;
2902   fFormat           := tfLuminance6Alpha2;
2903   fWithAlpha        := tfLuminance6Alpha2;
2904   fWithoutAlpha     := tfLuminance8;
2905   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2906 end;
2907
2908 constructor TfdLuminance8Alpha8.Create;
2909 begin
2910   inherited Create;
2911   fFormat           := tfLuminance8Alpha8;
2912   fWithAlpha        := tfLuminance8Alpha8;
2913   fWithoutAlpha     := tfLuminance8;
2914   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
2915 end;
2916
2917 constructor TfdLuminance12Alpha4.Create;
2918 begin
2919   inherited Create;
2920   fFormat           := tfLuminance12Alpha4;
2921   fWithAlpha        := tfLuminance12Alpha4;
2922   fWithoutAlpha     := tfLuminance12;
2923   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2924 end;
2925
2926 constructor TfdLuminance12Alpha12.Create;
2927 begin
2928   inherited Create;
2929   fFormat           := tfLuminance12Alpha12;
2930   fWithAlpha        := tfLuminance12Alpha12;
2931   fWithoutAlpha     := tfLuminance12;
2932   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
2933 end;
2934
2935 constructor TfdLuminance16Alpha16.Create;
2936 begin
2937   inherited Create;
2938   fFormat           := tfLuminance16Alpha16;
2939   fWithAlpha        := tfLuminance16Alpha16;
2940   fWithoutAlpha     := tfLuminance16;
2941   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2942 end;
2943
2944 constructor TfdR3G3B2.Create;
2945 begin
2946   inherited Create;
2947   fFormat           := tfR3G3B2;
2948   fWithAlpha        := tfRGBA2;
2949   fWithoutAlpha     := tfR3G3B2;
2950   fRange.r          := $7;
2951   fRange.g          := $7;
2952   fRange.b          := $3;
2953   fShift.r          :=  0;
2954   fShift.g          :=  3;
2955   fShift.b          :=  6;
2956   fglFormat         := GL_RGB;
2957   fglInternalFormat := GL_R3_G3_B2;
2958   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
2959 end;
2960
2961 constructor TfdRGB4.Create;
2962 begin
2963   inherited Create;
2964   fFormat           := tfRGB4;
2965   fWithAlpha        := tfRGBA4;
2966   fWithoutAlpha     := tfRGB4;
2967   fRGBInverted      := tfBGR4;
2968   fRange.r          := $F;
2969   fRange.g          := $F;
2970   fRange.b          := $F;
2971   fShift.r          :=  0;
2972   fShift.g          :=  4;
2973   fShift.b          :=  8;
2974   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2975   fglInternalFormat := GL_RGB4;
2976   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2977 end;
2978
2979 constructor TfdR5G6B5.Create;
2980 begin
2981   inherited Create;
2982   fFormat           := tfR5G6B5;
2983   fWithAlpha        := tfRGBA4;
2984   fWithoutAlpha     := tfR5G6B5;
2985   fRGBInverted      := tfB5G6R5;
2986   fRange.r          := $1F;
2987   fRange.g          := $3F;
2988   fRange.b          := $1F;
2989   fShift.r          :=   0;
2990   fShift.g          :=   5;
2991   fShift.b          :=  11;
2992   fglFormat         := GL_RGB;
2993   fglInternalFormat := GL_RGB565;
2994   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
2995 end;
2996
2997 constructor TfdRGB5.Create;
2998 begin
2999   inherited Create;
3000   fFormat           := tfRGB5;
3001   fWithAlpha        := tfRGB5A1;
3002   fWithoutAlpha     := tfRGB5;
3003   fRGBInverted      := tfBGR5;
3004   fRange.r          := $1F;
3005   fRange.g          := $1F;
3006   fRange.b          := $1F;
3007   fShift.r          :=   0;
3008   fShift.g          :=   5;
3009   fShift.b          :=  10;
3010   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3011   fglInternalFormat := GL_RGB5;
3012   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3013 end;
3014
3015 constructor TfdRGB8.Create;
3016 begin
3017   inherited Create;
3018   fFormat           := tfRGB8;
3019   fWithAlpha        := tfRGBA8;
3020   fWithoutAlpha     := tfRGB8;
3021   fRGBInverted      := tfBGR8;
3022   fglInternalFormat := GL_RGB8;
3023 end;
3024
3025 constructor TfdRGB10.Create;
3026 begin
3027   inherited Create;
3028   fFormat           := tfRGB10;
3029   fWithAlpha        := tfRGB10A2;
3030   fWithoutAlpha     := tfRGB10;
3031   fRGBInverted      := tfBGR10;
3032   fRange.r          := $3FF;
3033   fRange.g          := $3FF;
3034   fRange.b          := $3FF;
3035   fShift.r          :=    0;
3036   fShift.g          :=   10;
3037   fShift.b          :=   20;
3038   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3039   fglInternalFormat := GL_RGB10;
3040   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3041 end;
3042
3043 constructor TfdRGB12.Create;
3044 begin
3045   inherited Create;
3046   fFormat           := tfRGB12;
3047   fWithAlpha        := tfRGBA12;
3048   fWithoutAlpha     := tfRGB12;
3049   fRGBInverted      := tfBGR12;
3050   fglInternalFormat := GL_RGB12;
3051 end;
3052
3053 constructor TfdRGB16.Create;
3054 begin
3055   inherited Create;
3056   fFormat           := tfRGB16;
3057   fWithAlpha        := tfRGBA16;
3058   fWithoutAlpha     := tfRGB16;
3059   fRGBInverted      := tfBGR16;
3060   fglInternalFormat := GL_RGB16;
3061 end;
3062
3063 constructor TfdRGBA2.Create;
3064 begin
3065   inherited Create;
3066   fFormat           := tfRGBA2;
3067   fWithAlpha        := tfRGBA2;
3068   fWithoutAlpha     := tfR3G3B2;
3069   fRGBInverted      := tfBGRA2;
3070   fglInternalFormat := GL_RGBA2;
3071 end;
3072
3073 constructor TfdRGBA4.Create;
3074 begin
3075   inherited Create;
3076   fFormat           := tfRGBA4;
3077   fWithAlpha        := tfRGBA4;
3078   fWithoutAlpha     := tfRGB4;
3079   fRGBInverted      := tfBGRA4;
3080   fRange.r          := $F;
3081   fRange.g          := $F;
3082   fRange.b          := $F;
3083   fRange.a          := $F;
3084   fShift.r          :=  0;
3085   fShift.g          :=  4;
3086   fShift.b          :=  8;
3087   fShift.a          := 12;
3088   fglFormat         := GL_RGBA;
3089   fglInternalFormat := GL_RGBA4;
3090   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3091 end;
3092
3093 constructor TfdRGB5A1.Create;
3094 begin
3095   inherited Create;
3096   fFormat           := tfRGB5A1;
3097   fWithAlpha        := tfRGB5A1;
3098   fWithoutAlpha     := tfRGB5;
3099   fRGBInverted      := tfBGR5A1;
3100   fRange.r          := $1F;
3101   fRange.g          := $1F;
3102   fRange.b          := $1F;
3103   fRange.a          := $01;
3104   fShift.r          :=   0;
3105   fShift.g          :=   5;
3106   fShift.b          :=  10;
3107   fShift.a          :=  15;
3108   fglFormat         := GL_RGBA;
3109   fglInternalFormat := GL_RGB5_A1;
3110   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3111 end;
3112
3113 constructor TfdRGBA8.Create;
3114 begin
3115   inherited Create;
3116   fFormat           := tfRGBA8;
3117   fWithAlpha        := tfRGBA8;
3118   fWithoutAlpha     := tfRGB8;
3119   fRGBInverted      := tfBGRA8;
3120   fglInternalFormat := GL_RGBA8;
3121 end;
3122
3123 constructor TfdRGB10A2.Create;
3124 begin
3125   inherited Create;
3126   fFormat           := tfRGB10A2;
3127   fWithAlpha        := tfRGB10A2;
3128   fWithoutAlpha     := tfRGB10;
3129   fRGBInverted      := tfBGR10A2;
3130   fRange.r          := $3FF;
3131   fRange.g          := $3FF;
3132   fRange.b          := $3FF;
3133   fRange.a          := $003;
3134   fShift.r          :=    0;
3135   fShift.g          :=   10;
3136   fShift.b          :=   20;
3137   fShift.a          :=   30;
3138   fglFormat         := GL_RGBA;
3139   fglInternalFormat := GL_RGB10_A2;
3140   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3141 end;
3142
3143 constructor TfdRGBA12.Create;
3144 begin
3145   inherited Create;
3146   fFormat           := tfRGBA12;
3147   fWithAlpha        := tfRGBA12;
3148   fWithoutAlpha     := tfRGB12;
3149   fRGBInverted      := tfBGRA12;
3150   fglInternalFormat := GL_RGBA12;
3151 end;
3152
3153 constructor TfdRGBA16.Create;
3154 begin
3155   inherited Create;
3156   fFormat           := tfRGBA16;
3157   fWithAlpha        := tfRGBA16;
3158   fWithoutAlpha     := tfRGB16;
3159   fRGBInverted      := tfBGRA16;
3160   fglInternalFormat := GL_RGBA16;
3161 end;
3162
3163 constructor TfdBGR4.Create;
3164 begin
3165   inherited Create;
3166   fPixelSize        := 2.0;
3167   fFormat           := tfBGR4;
3168   fWithAlpha        := tfBGRA4;
3169   fWithoutAlpha     := tfBGR4;
3170   fRGBInverted      := tfRGB4;
3171   fRange.r          := $F;
3172   fRange.g          := $F;
3173   fRange.b          := $F;
3174   fRange.a          := $0;
3175   fShift.r          :=  8;
3176   fShift.g          :=  4;
3177   fShift.b          :=  0;
3178   fShift.a          :=  0;
3179   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3180   fglInternalFormat := GL_RGB4;
3181   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3182 end;
3183
3184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3186 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3187 constructor TfdB5G6R5.Create;
3188 begin
3189   inherited Create;
3190   fFormat           := tfB5G6R5;
3191   fWithAlpha        := tfBGRA4;
3192   fWithoutAlpha     := tfB5G6R5;
3193   fRGBInverted      := tfR5G6B5;
3194   fRange.r          := $1F;
3195   fRange.g          := $3F;
3196   fRange.b          := $1F;
3197   fShift.r          :=  11;
3198   fShift.g          :=   5;
3199   fShift.b          :=   0;
3200   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3201   fglInternalFormat := GL_RGB8;
3202   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3203 end;
3204
3205 constructor TfdBGR5.Create;
3206 begin
3207   inherited Create;
3208   fPixelSize        := 2.0;
3209   fFormat           := tfBGR5;
3210   fWithAlpha        := tfBGR5A1;
3211   fWithoutAlpha     := tfBGR5;
3212   fRGBInverted      := tfRGB5;
3213   fRange.r          := $1F;
3214   fRange.g          := $1F;
3215   fRange.b          := $1F;
3216   fRange.a          := $00;
3217   fShift.r          :=  10;
3218   fShift.g          :=   5;
3219   fShift.b          :=   0;
3220   fShift.a          :=   0;
3221   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3222   fglInternalFormat := GL_RGB5;
3223   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3224 end;
3225
3226 constructor TfdBGR8.Create;
3227 begin
3228   inherited Create;
3229   fFormat           := tfBGR8;
3230   fWithAlpha        := tfBGRA8;
3231   fWithoutAlpha     := tfBGR8;
3232   fRGBInverted      := tfRGB8;
3233   fglInternalFormat := GL_RGB8;
3234 end;
3235
3236 constructor TfdBGR10.Create;
3237 begin
3238   inherited Create;
3239   fFormat           := tfBGR10;
3240   fWithAlpha        := tfBGR10A2;
3241   fWithoutAlpha     := tfBGR10;
3242   fRGBInverted      := tfRGB10;
3243   fRange.r          := $3FF;
3244   fRange.g          := $3FF;
3245   fRange.b          := $3FF;
3246   fRange.a          := $000;
3247   fShift.r          :=   20;
3248   fShift.g          :=   10;
3249   fShift.b          :=    0;
3250   fShift.a          :=    0;
3251   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3252   fglInternalFormat := GL_RGB10;
3253   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3254 end;
3255
3256 constructor TfdBGR12.Create;
3257 begin
3258   inherited Create;
3259   fFormat           := tfBGR12;
3260   fWithAlpha        := tfBGRA12;
3261   fWithoutAlpha     := tfBGR12;
3262   fRGBInverted      := tfRGB12;
3263   fglInternalFormat := GL_RGB12;
3264 end;
3265
3266 constructor TfdBGR16.Create;
3267 begin
3268   inherited Create;
3269   fFormat           := tfBGR16;
3270   fWithAlpha        := tfBGRA16;
3271   fWithoutAlpha     := tfBGR16;
3272   fRGBInverted      := tfRGB16;
3273   fglInternalFormat := GL_RGB16;
3274 end;
3275
3276 constructor TfdBGRA2.Create;
3277 begin
3278   inherited Create;
3279   fFormat           := tfBGRA2;
3280   fWithAlpha        := tfBGRA4;
3281   fWithoutAlpha     := tfBGR4;
3282   fRGBInverted      := tfRGBA2;
3283   fglInternalFormat := GL_RGBA2;
3284 end;
3285
3286 constructor TfdBGRA4.Create;
3287 begin
3288   inherited Create;
3289   fFormat           := tfBGRA4;
3290   fWithAlpha        := tfBGRA4;
3291   fWithoutAlpha     := tfBGR4;
3292   fRGBInverted      := tfRGBA4;
3293   fRange.r          := $F;
3294   fRange.g          := $F;
3295   fRange.b          := $F;
3296   fRange.a          := $F;
3297   fShift.r          :=  8;
3298   fShift.g          :=  4;
3299   fShift.b          :=  0;
3300   fShift.a          := 12;
3301   fglFormat         := GL_BGRA;
3302   fglInternalFormat := GL_RGBA4;
3303   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3304 end;
3305
3306 constructor TfdBGR5A1.Create;
3307 begin
3308   inherited Create;
3309   fFormat           := tfBGR5A1;
3310   fWithAlpha        := tfBGR5A1;
3311   fWithoutAlpha     := tfBGR5;
3312   fRGBInverted      := tfRGB5A1;
3313   fRange.r          := $1F;
3314   fRange.g          := $1F;
3315   fRange.b          := $1F;
3316   fRange.a          := $01;
3317   fShift.r          :=  10;
3318   fShift.g          :=   5;
3319   fShift.b          :=   0;
3320   fShift.a          :=  15;
3321   fglFormat         := GL_BGRA;
3322   fglInternalFormat := GL_RGB5_A1;
3323   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3324 end;
3325
3326 constructor TfdBGRA8.Create;
3327 begin
3328   inherited Create;
3329   fFormat           := tfBGRA8;
3330   fWithAlpha        := tfBGRA8;
3331   fWithoutAlpha     := tfBGR8;
3332   fRGBInverted      := tfRGBA8;
3333   fglInternalFormat := GL_RGBA8;
3334 end;
3335
3336 constructor TfdBGR10A2.Create;
3337 begin
3338   inherited Create;
3339   fFormat           := tfBGR10A2;
3340   fWithAlpha        := tfBGR10A2;
3341   fWithoutAlpha     := tfBGR10;
3342   fRGBInverted      := tfRGB10A2;
3343   fRange.r          := $3FF;
3344   fRange.g          := $3FF;
3345   fRange.b          := $3FF;
3346   fRange.a          := $003;
3347   fShift.r          :=   20;
3348   fShift.g          :=   10;
3349   fShift.b          :=    0;
3350   fShift.a          :=   30;
3351   fglFormat         := GL_BGRA;
3352   fglInternalFormat := GL_RGB10_A2;
3353   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3354 end;
3355
3356 constructor TfdBGRA12.Create;
3357 begin
3358   inherited Create;
3359   fFormat           := tfBGRA12;
3360   fWithAlpha        := tfBGRA12;
3361   fWithoutAlpha     := tfBGR12;
3362   fRGBInverted      := tfRGBA12;
3363   fglInternalFormat := GL_RGBA12;
3364 end;
3365
3366 constructor TfdBGRA16.Create;
3367 begin
3368   inherited Create;
3369   fFormat           := tfBGRA16;
3370   fWithAlpha        := tfBGRA16;
3371   fWithoutAlpha     := tfBGR16;
3372   fRGBInverted      := tfRGBA16;
3373   fglInternalFormat := GL_RGBA16;
3374 end;
3375
3376 constructor TfdDepth16.Create;
3377 begin
3378   inherited Create;
3379   fFormat           := tfDepth16;
3380   fWithAlpha        := tfEmpty;
3381   fWithoutAlpha     := tfDepth16;
3382   fglInternalFormat := GL_DEPTH_COMPONENT16;
3383 end;
3384
3385 constructor TfdDepth24.Create;
3386 begin
3387   inherited Create;
3388   fFormat           := tfDepth24;
3389   fWithAlpha        := tfEmpty;
3390   fWithoutAlpha     := tfDepth24;
3391   fglInternalFormat := GL_DEPTH_COMPONENT24;
3392 end;
3393
3394 constructor TfdDepth32.Create;
3395 begin
3396   inherited Create;
3397   fFormat           := tfDepth32;
3398   fWithAlpha        := tfEmpty;
3399   fWithoutAlpha     := tfDepth32;
3400   fglInternalFormat := GL_DEPTH_COMPONENT32;
3401 end;
3402
3403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3404 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3406 class procedure TFormatDescriptor.Init;
3407 begin
3408   if not Assigned(FormatDescriptorCS) then
3409     FormatDescriptorCS := TCriticalSection.Create;
3410 end;
3411
3412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3413 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3414 begin
3415   FormatDescriptorCS.Enter;
3416   try
3417     result := FormatDescriptors[aFormat];
3418     if not Assigned(result) then begin
3419       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3420       FormatDescriptors[aFormat] := result;
3421     end;
3422   finally
3423     FormatDescriptorCS.Leave;
3424   end;
3425 end;
3426
3427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3428 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3429 begin
3430   result := Get(Get(aFormat).WithAlpha);
3431 end;
3432
3433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3434 class procedure TFormatDescriptor.Clear;
3435 var
3436   f: TglBitmapFormat;
3437 begin
3438   FormatDescriptorCS.Enter;
3439   try
3440     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3441       FreeAndNil(FormatDescriptors[f]);
3442   finally
3443     FormatDescriptorCS.Leave;
3444   end;
3445 end;
3446
3447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3448 class procedure TFormatDescriptor.Finalize;
3449 begin
3450   Clear;
3451   FreeAndNil(FormatDescriptorCS);
3452 end;
3453
3454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3455 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3457 procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
3458 begin
3459   Update(aValue, fRange.r, fShift.r);
3460 end;
3461
3462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3463 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
3464 begin
3465   Update(aValue, fRange.g, fShift.g);
3466 end;
3467
3468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3469 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
3470 begin
3471   Update(aValue, fRange.b, fShift.b);
3472 end;
3473
3474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3475 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
3476 begin
3477   Update(aValue, fRange.a, fShift.a);
3478 end;
3479
3480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3481 procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
3482   aShift: Byte);
3483 begin
3484   aShift := 0;
3485   aRange := 0;
3486   if (aMask = 0) then
3487     exit;
3488   while (aMask > 0) and ((aMask and 1) = 0) do begin
3489     inc(aShift);
3490     aMask := aMask shr 1;
3491   end;
3492   aRange := 1;
3493   while (aMask > 0) do begin
3494     aRange := aRange shl 1;
3495     aMask  := aMask  shr 1;
3496   end;
3497   dec(aRange);
3498
3499   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3500 end;
3501
3502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3503 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3504 var
3505   data: UInt64;
3506   s: Integer;
3507 type
3508   PUInt64 = ^UInt64;
3509 begin
3510   data :=
3511     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3512     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3513     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3514     ((aPixel.Data.a and fRange.a) shl fShift.a);
3515   s := Round(fPixelSize);
3516   case s of
3517     1:           aData^  := data;
3518     2:     PWord(aData)^ := data;
3519     4: PCardinal(aData)^ := data;
3520     8:   PUInt64(aData)^ := data;
3521   else
3522     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3523   end;
3524   inc(aData, s);
3525 end;
3526
3527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3528 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3529 var
3530   data: UInt64;
3531   s, i: Integer;
3532 type
3533   PUInt64 = ^UInt64;
3534 begin
3535   s := Round(fPixelSize);
3536   case s of
3537     1: data :=           aData^;
3538     2: data :=     PWord(aData)^;
3539     4: data := PCardinal(aData)^;
3540     8: data :=   PUInt64(aData)^;
3541   else
3542     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3543   end;
3544   for i := 0 to 3 do
3545     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3546   inc(aData, s);
3547 end;
3548
3549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3550 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3552 procedure TbmpColorTableFormat.CreateColorTable;
3553 var
3554   bits: Byte;
3555   len: Integer;
3556   i: Integer;
3557 begin
3558   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3559     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3560
3561   if (Format = tfLuminance4) then
3562     SetLength(fColorTable, 16)
3563   else
3564     SetLength(fColorTable, 256);
3565
3566   case Format of
3567     tfLuminance4: begin
3568       for i := 0 to High(fColorTable) do begin
3569         fColorTable[i].r := 16 * i;
3570         fColorTable[i].g := 16 * i;
3571         fColorTable[i].b := 16 * i;
3572         fColorTable[i].a := 0;
3573       end;
3574     end;
3575
3576     tfLuminance8: begin
3577       for i := 0 to High(fColorTable) do begin
3578         fColorTable[i].r := i;
3579         fColorTable[i].g := i;
3580         fColorTable[i].b := i;
3581         fColorTable[i].a := 0;
3582       end;
3583     end;
3584
3585     tfR3G3B2: begin
3586       for i := 0 to High(fColorTable) do begin
3587         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3588         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3589         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3590         fColorTable[i].a := 0;
3591       end;
3592     end;
3593   end;
3594 end;
3595
3596 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3597 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3598 var
3599   d: Byte;
3600 begin
3601   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3602     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3603
3604   case Format of
3605     tfLuminance4: begin
3606       if (aMapData = nil) then
3607         aData^ := 0;
3608       d := LuminanceWeight(aPixel) and Range.r;
3609       aData^ := aData^ or (d shl (4 - PtrInt(aMapData)));
3610       inc(aMapData, 4);
3611       if (PtrInt(aMapData) >= 8) then begin
3612         inc(aData);
3613         aMapData := nil;
3614       end;
3615     end;
3616
3617     tfLuminance8: begin
3618       aData^ := LuminanceWeight(aPixel) and Range.r;
3619       inc(aData);
3620     end;
3621
3622     tfR3G3B2: begin
3623       aData^ := Round(
3624         ((aPixel.Data.r and Range.r) shl Shift.r) or
3625         ((aPixel.Data.g and Range.g) shl Shift.g) or
3626         ((aPixel.Data.b and Range.b) shl Shift.b));
3627       inc(aData);
3628     end;
3629   end;
3630 end;
3631
3632 procedure TbmpColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3633 type
3634   PUInt64 = ^UInt64;
3635 var
3636   idx: UInt64;
3637   s: Integer;
3638   bits: Byte;
3639   f: Single;
3640 begin
3641   s    := Trunc(fPixelSize);
3642   f    := fPixelSize - s;
3643   bits := Round(8 * f);
3644   case s of
3645     0: idx :=          (aData^ shr (8 - bits - PtrInt(aMapData))) and ((1 shl bits) - 1);
3646     1: idx :=           aData^;
3647     2: idx :=     PWord(aData)^;
3648     4: idx := PCardinal(aData)^;
3649     8: idx :=   PUInt64(aData)^;
3650   else
3651     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3652   end;
3653   if (idx >= Length(fColorTable)) then
3654     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3655   with fColorTable[idx] do begin
3656     aPixel.Data.r := r;
3657     aPixel.Data.g := g;
3658     aPixel.Data.b := b;
3659     aPixel.Data.a := a;
3660   end;
3661   inc(aMapData, bits);
3662   if (PtrInt(aMapData) >= 8) then begin
3663     inc(aData, 1);
3664     dec(aMapData, 8);
3665   end;
3666   inc(aData, s);
3667 end;
3668
3669 destructor TbmpColorTableFormat.Destroy;
3670 begin
3671   SetLength(fColorTable, 0);
3672   inherited Destroy;
3673 end;
3674
3675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3676 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3678 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3679 begin
3680   with aFuncRec do begin
3681     if (Source.Range.r   > 0) then
3682       Dest.Data.r := Source.Data.r;
3683     if (Source.Range.g > 0) then
3684       Dest.Data.g := Source.Data.g;
3685     if (Source.Range.b  > 0) then
3686       Dest.Data.b := Source.Data.b;
3687     if (Source.Range.a > 0) then
3688       Dest.Data.a := Source.Data.a;
3689   end;
3690 end;
3691
3692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3693 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3694 var
3695   i: Integer;
3696 begin
3697   with aFuncRec do begin
3698     for i := 0 to 3 do
3699       if (Source.Range.arr[i] > 0) then
3700         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3701   end;
3702 end;
3703
3704 type
3705   TShiftData = packed record
3706     case Integer of
3707       0: (r, g, b, a: SmallInt);
3708       1: (arr: array[0..3] of SmallInt);
3709   end;
3710   PShiftData = ^TShiftData;
3711
3712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3713 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3714 var
3715   i: Integer;
3716 begin
3717   with aFuncRec do
3718     for i := 0 to 3 do
3719       if (Source.Range.arr[i] > 0) then
3720         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3721 end;
3722
3723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3724 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3725 begin
3726   with aFuncRec do begin
3727     Dest.Data.r := Source.Data.r;
3728     Dest.Data.g := Source.Data.g;
3729     Dest.Data.b := Source.Data.b;
3730     Dest.Data.a := Source.Data.a;
3731     if (Args and $1 > 0) then begin
3732       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3733       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3734       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3735     end;
3736     if (Args and $2 > 0) then begin
3737       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3738     end;
3739   end;
3740 end;
3741
3742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3743 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3744 var
3745   i: Integer;
3746 begin
3747   with aFuncRec do begin
3748     for i := 0 to 3 do
3749       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3750   end;
3751 end;
3752
3753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3754 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3755 var
3756   Temp: Single;
3757 begin
3758   with FuncRec do begin
3759     if (FuncRec.Args = 0) then begin //source has no alpha
3760       Temp :=
3761         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3762         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3763         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3764       Dest.Data.a := Round(Dest.Range.a * Temp);
3765     end else
3766       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3767   end;
3768 end;
3769
3770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3771 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3772 type
3773   PglBitmapPixelData = ^TglBitmapPixelData;
3774 begin
3775   with FuncRec do begin
3776     Dest.Data.r := Source.Data.r;
3777     Dest.Data.g := Source.Data.g;
3778     Dest.Data.b := Source.Data.b;
3779
3780     with PglBitmapPixelData(Args)^ do
3781       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
3782           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
3783           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
3784         Dest.Data.a := 0
3785       else
3786         Dest.Data.a := Dest.Range.a;
3787   end;
3788 end;
3789
3790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3791 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3792 type
3793   PglBitmapPixelData = ^TglBitmapPixelData;
3794 begin
3795   with FuncRec do begin
3796     Dest.Data.r := Source.Data.r;
3797     Dest.Data.g := Source.Data.g;
3798     Dest.Data.b := Source.Data.b;
3799     Dest.Data.a := PCardinal(Args)^;
3800   end;
3801 end;
3802
3803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3804 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
3805 type
3806   PRGBPix = ^TRGBPix;
3807   TRGBPix = array [0..2] of byte;
3808 var
3809   Temp: Byte;
3810 begin
3811   while aWidth > 0 do begin
3812     Temp := PRGBPix(aData)^[0];
3813     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
3814     PRGBPix(aData)^[2] := Temp;
3815
3816     if aHasAlpha then
3817       Inc(aData, 4)
3818     else
3819       Inc(aData, 3);
3820     dec(aWidth);
3821   end;
3822 end;
3823
3824 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3825 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3827 function TglBitmap.GetWidth: Integer;
3828 begin
3829   if (ffX in fDimension.Fields) then
3830     result := fDimension.X
3831   else
3832     result := -1;
3833 end;
3834
3835 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3836 function TglBitmap.GetHeight: Integer;
3837 begin
3838   if (ffY in fDimension.Fields) then
3839     result := fDimension.Y
3840   else
3841     result := -1;
3842 end;
3843
3844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3845 function TglBitmap.GetFileWidth: Integer;
3846 begin
3847   result := Max(1, Width);
3848 end;
3849
3850 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3851 function TglBitmap.GetFileHeight: Integer;
3852 begin
3853   result := Max(1, Height);
3854 end;
3855
3856 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3857 procedure TglBitmap.SetCustomData(const aValue: Pointer);
3858 begin
3859   if fCustomData = aValue then
3860     exit;
3861   fCustomData := aValue;
3862 end;
3863
3864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3865 procedure TglBitmap.SetCustomName(const aValue: String);
3866 begin
3867   if fCustomName = aValue then
3868     exit;
3869   fCustomName := aValue;
3870 end;
3871
3872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3873 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
3874 begin
3875   if fCustomNameW = aValue then
3876     exit;
3877   fCustomNameW := aValue;
3878 end;
3879
3880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3881 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
3882 begin
3883   if fDeleteTextureOnFree = aValue then
3884     exit;
3885   fDeleteTextureOnFree := aValue;
3886 end;
3887
3888 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3889 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
3890 begin
3891   if fFormat = aValue then
3892     exit;
3893   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
3894     raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
3895   SetDataPointer(Data, aValue, Width, Height);
3896 end;
3897
3898 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3899 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
3900 begin
3901   if fFreeDataAfterGenTexture = aValue then
3902     exit;
3903   fFreeDataAfterGenTexture := aValue;
3904 end;
3905
3906 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3907 procedure TglBitmap.SetID(const aValue: Cardinal);
3908 begin
3909   if fID = aValue then
3910     exit;
3911   fID := aValue;
3912 end;
3913
3914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3915 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
3916 begin
3917   if fMipMap = aValue then
3918     exit;
3919   fMipMap := aValue;
3920 end;
3921
3922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3923 procedure TglBitmap.SetTarget(const aValue: Cardinal);
3924 begin
3925   if fTarget = aValue then
3926     exit;
3927   fTarget := aValue;
3928 end;
3929
3930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3931 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
3932 var
3933   MaxAnisotropic: Integer;
3934 begin
3935   fAnisotropic := aValue;
3936   if (ID > 0) then begin
3937     if GL_EXT_texture_filter_anisotropic then begin
3938       if fAnisotropic > 0 then begin
3939         Bind(false);
3940         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
3941         if aValue > MaxAnisotropic then
3942           fAnisotropic := MaxAnisotropic;
3943         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
3944       end;
3945     end else begin
3946       fAnisotropic := 0;
3947     end;
3948   end;
3949 end;
3950
3951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3952 procedure TglBitmap.CreateID;
3953 begin
3954   if (ID <> 0) then
3955     glDeleteTextures(1, @fID);
3956   glGenTextures(1, @fID);
3957   Bind(false);
3958 end;
3959
3960 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3961 procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
3962 begin
3963   // Set Up Parameters
3964   SetWrap(fWrapS, fWrapT, fWrapR);
3965   SetFilter(fFilterMin, fFilterMag);
3966   SetAnisotropic(fAnisotropic);
3967   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
3968
3969   // Mip Maps Generation Mode
3970   aBuildWithGlu := false;
3971   if (MipMap = mmMipmap) then begin
3972     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
3973       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
3974     else
3975       aBuildWithGlu := true;
3976   end else if (MipMap = mmMipmapGlu) then
3977     aBuildWithGlu := true;
3978 end;
3979
3980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3981 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
3982   const aWidth: Integer; const aHeight: Integer);
3983 var
3984   s: Single;
3985 begin
3986   if (Data <> aData) then begin
3987     if (Assigned(Data)) then
3988       FreeMem(Data);
3989     fData := aData;
3990   end;
3991
3992   FillChar(fDimension, SizeOf(fDimension), 0);
3993   if not Assigned(fData) then begin
3994     fFormat    := tfEmpty;
3995     fPixelSize := 0;
3996     fRowSize   := 0;
3997   end else begin
3998     if aWidth <> -1 then begin
3999       fDimension.Fields := fDimension.Fields + [ffX];
4000       fDimension.X := aWidth;
4001     end;
4002
4003     if aHeight <> -1 then begin
4004       fDimension.Fields := fDimension.Fields + [ffY];
4005       fDimension.Y := aHeight;
4006     end;
4007
4008     s := TFormatDescriptor.Get(aFormat).PixelSize;
4009     fFormat    := aFormat;
4010     fPixelSize := Ceil(s);
4011     fRowSize   := Ceil(s * aWidth);
4012   end;
4013 end;
4014
4015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4016 function TglBitmap.FlipHorz: Boolean;
4017 begin
4018   result := false;
4019 end;
4020
4021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4022 function TglBitmap.FlipVert: Boolean;
4023 begin
4024   result := false;
4025 end;
4026
4027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4028 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4030 procedure TglBitmap.AfterConstruction;
4031 begin
4032   inherited AfterConstruction;
4033
4034   fID         := 0;
4035   fTarget     := 0;
4036   fIsResident := false;
4037
4038   fFormat                  := glBitmapGetDefaultFormat;
4039   fMipMap                  := glBitmapDefaultMipmap;
4040   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4041   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4042
4043   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4044   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4045 end;
4046
4047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4048 procedure TglBitmap.BeforeDestruction;
4049 begin
4050   SetDataPointer(nil, tfEmpty);
4051   if (fID > 0) and fDeleteTextureOnFree then
4052     glDeleteTextures(1, @fID);
4053   inherited BeforeDestruction;
4054 end;
4055
4056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4057 procedure TglBitmap.LoadFromFile(const aFilename: String);
4058 var
4059   fs: TFileStream;
4060 begin
4061   if not FileExists(aFilename) then
4062     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4063   fFilename := aFilename;
4064   fs := TFileStream.Create(fFilename, fmOpenRead);
4065   try
4066     fs.Position := 0;
4067     LoadFromStream(fs);
4068   finally
4069     fs.Free;
4070   end;
4071 end;
4072
4073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4074 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4075 begin
4076   {$IFDEF GLB_SUPPORT_PNG_READ}
4077   if not LoadPNG(aStream) then
4078   {$ENDIF}
4079   {$IFDEF GLB_SUPPORT_JPEG_READ}
4080   if not LoadJPEG(aStream) then
4081   {$ENDIF}
4082   if not LoadDDS(aStream) then
4083   if not LoadTGA(aStream) then
4084   if not LoadBMP(aStream) then
4085     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4086 end;
4087
4088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4089 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4090   const aFormat: TglBitmapFormat; const aArgs: PtrInt);
4091 var
4092   tmpData: PByte;
4093   size: Integer;
4094 begin
4095   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4096   GetMem(tmpData, size);
4097   try
4098     FillChar(tmpData^, size, #$FF);
4099     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4100   except
4101     FreeMem(tmpData);
4102     raise;
4103   end;
4104   AddFunc(Self, aFunc, false, Format, aArgs);
4105 end;
4106
4107 {$IFDEF GLB_DELPHI}
4108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4109 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
4110 var
4111   rs: TResourceStream;
4112   TempPos: Integer;
4113   ResTypeStr: String;
4114   TempResType: PChar;
4115 begin
4116   if not Assigned(ResType) then begin
4117     TempPos     := Pos('.', Resource);
4118     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4119     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));
4120     TempResType := PChar(ResTypeStr);
4121   end else
4122     TempResType := ResType
4123
4124   rs := TResourceStream.Create(Instance, Resource, TempResType);
4125   try
4126     LoadFromStream(rs);
4127   finally
4128     rs.Free;
4129   end;
4130 end;
4131
4132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4133 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4134 var
4135   rs: TResourceStream;
4136 begin
4137   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4138   try
4139     LoadFromStream(rs);
4140   finally
4141     rs.Free;
4142   end;
4143 end;
4144 {$ENDIF}
4145
4146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4147 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4148 var
4149   fs: TFileStream;
4150 begin
4151   fs := TFileStream.Create(aFileName, fmCreate);
4152   try
4153     fs.Position := 0;
4154     SaveToStream(fs, aFileType);
4155   finally
4156     fs.Free;
4157   end;
4158 end;
4159
4160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4161 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4162 begin
4163   case aFileType of
4164     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4165     ftPNG:  SavePng(aStream);
4166     {$ENDIF}
4167     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4168     ftJPEG: SaveJPEG(aStream);
4169     {$ENDIF}
4170     ftDDS:  SaveDDS(aStream);
4171     ftTGA:  SaveTGA(aStream);
4172     ftBMP:  SaveBMP(aStream);
4173   end;
4174 end;
4175
4176 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4177 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
4178 begin
4179   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4180 end;
4181
4182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4183 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4184   const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
4185 var
4186   DestData, TmpData, SourceData: pByte;
4187   TempHeight, TempWidth: Integer;
4188   SourceFD, DestFD: TFormatDescriptor;
4189   SourceMD, DestMD: Pointer;
4190
4191   FuncRec: TglBitmapFunctionRec;
4192 begin
4193   Assert(Assigned(Data));
4194   Assert(Assigned(aSource));
4195   Assert(Assigned(aSource.Data));
4196
4197   result := false;
4198   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4199     SourceFD := TFormatDescriptor.Get(aSource.Format);
4200     DestFD   := TFormatDescriptor.Get(aFormat);
4201
4202     // inkompatible Formats so CreateTemp
4203     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4204       aCreateTemp := true;
4205
4206     // Values
4207     TempHeight := Max(1, aSource.Height);
4208     TempWidth  := Max(1, aSource.Width);
4209
4210     FuncRec.Sender := Self;
4211     FuncRec.Args   := aArgs;
4212
4213     TmpData := nil;
4214     if aCreateTemp then begin
4215       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
4216       DestData := TmpData;
4217     end else
4218       DestData := Data;
4219
4220     try
4221       SourceFD.PreparePixel(FuncRec.Source);
4222       DestFD.PreparePixel  (FuncRec.Dest);
4223
4224       SourceMD := SourceFD.CreateMappingData;
4225       DestMD   := DestFD.CreateMappingData;
4226
4227       FuncRec.Size            := aSource.Dimension;
4228       FuncRec.Position.Fields := FuncRec.Size.Fields;
4229
4230       try
4231         SourceData := aSource.Data;
4232         FuncRec.Position.Y := 0;
4233         while FuncRec.Position.Y < TempHeight do begin
4234           FuncRec.Position.X := 0;
4235           while FuncRec.Position.X < TempWidth do begin
4236             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4237             aFunc(FuncRec);
4238             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4239             inc(FuncRec.Position.X);
4240           end;
4241           inc(FuncRec.Position.Y);
4242         end;
4243
4244         // Updating Image or InternalFormat
4245         if aCreateTemp then
4246           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4247         else if (aFormat <> fFormat) then
4248           Format := aFormat;
4249
4250         result := true;
4251       finally
4252         SourceFD.FreeMappingData(SourceMD);
4253         DestFD.FreeMappingData(DestMD);
4254       end;
4255     except
4256       if aCreateTemp then
4257         FreeMem(TmpData);
4258       raise;
4259     end;
4260   end;
4261 end;
4262
4263 {$IFDEF GLB_SDL}
4264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4265 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4266 var
4267   Row, RowSize: Integer;
4268   SourceData, TmpData: PByte;
4269   TempDepth: Integer;
4270   Pix: TglBitmapPixelData;
4271   FormatDesc: TglBitmapFormatDescriptor;
4272
4273   function GetRowPointer(Row: Integer): pByte;
4274   begin
4275     result := Surface.pixels;
4276     Inc(result, Row * RowSize);
4277   end;
4278
4279 begin
4280   result := false;
4281
4282   (* TODO
4283   if not FormatIsUncompressed(InternalFormat) then
4284     raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
4285   *)
4286
4287   FormatDesc := FORMAT_DESCRIPTORS[Format];
4288   if Assigned(Data) then begin
4289     case Trunc(FormatDesc.GetSize) of
4290       1: TempDepth :=  8;
4291       2: TempDepth := 16;
4292       3: TempDepth := 24;
4293       4: TempDepth := 32;
4294     else
4295       raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
4296     end;
4297     FormatDesc.PreparePixel(Pix);
4298     with Pix.PixelDesc do
4299       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4300         RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
4301
4302     SourceData := Data;
4303     RowSize    := Ceil(FileWidth * FormatDesc.GetSize);
4304
4305     for Row := 0 to FileHeight -1 do begin
4306       TmpData := GetRowPointer(Row);
4307       if Assigned(TmpData) then begin
4308         Move(SourceData^, TmpData^, RowSize);
4309         inc(SourceData, RowSize);
4310       end;
4311     end;
4312     result := true;
4313   end;
4314 end;
4315
4316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4317 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4318 var
4319   pSource, pData, pTempData: PByte;
4320   Row, RowSize, TempWidth, TempHeight: Integer;
4321   IntFormat, f: TglBitmapInternalFormat;
4322   FormatDesc: TglBitmapFormatDescriptor;
4323
4324   function GetRowPointer(Row: Integer): pByte;
4325   begin
4326     result := Surface^.pixels;
4327     Inc(result, Row * RowSize);
4328   end;
4329
4330 begin
4331   result := false;
4332   if (Assigned(Surface)) then begin
4333     with Surface^.format^ do begin
4334       IntFormat := tfEmpty;
4335       for f := Low(f) to High(f) do begin
4336         if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
4337           IntFormat := f;
4338           break;
4339         end;
4340       end;
4341       if (IntFormat = tfEmpty) then
4342         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4343     end;
4344
4345     FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
4346     TempWidth  := Surface^.w;
4347     TempHeight := Surface^.h;
4348     RowSize := Trunc(TempWidth * FormatDesc.GetSize);
4349     GetMem(pData, TempHeight * RowSize);
4350     try
4351       pTempData := pData;
4352       for Row := 0 to TempHeight -1 do begin
4353         pSource := GetRowPointer(Row);
4354         if (Assigned(pSource)) then begin
4355           Move(pSource^, pTempData^, RowSize);
4356           Inc(pTempData, RowSize);
4357         end;
4358       end;
4359       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4360       result := true;
4361     except
4362       FreeMem(pData);
4363       raise;
4364     end;
4365   end;
4366 end;
4367
4368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4369 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4370 var
4371   Row, Col, AlphaInterleave: Integer;
4372   pSource, pDest: PByte;
4373
4374   function GetRowPointer(Row: Integer): pByte;
4375   begin
4376     result := aSurface.pixels;
4377     Inc(result, Row * Width);
4378   end;
4379
4380 begin
4381   result := false;
4382   if Assigned(Data) then begin
4383     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4384       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4385
4386       AlphaInterleave := 0;
4387       case Format of
4388         ifLuminance8Alpha8:
4389           AlphaInterleave := 1;
4390         ifBGRA8, ifRGBA8:
4391           AlphaInterleave := 3;
4392       end;
4393
4394       pSource := Data;
4395       for Row := 0 to Height -1 do begin
4396         pDest := GetRowPointer(Row);
4397         if Assigned(pDest) then begin
4398           for Col := 0 to Width -1 do begin
4399             Inc(pSource, AlphaInterleave);
4400             pDest^ := pSource^;
4401             Inc(pDest);
4402             Inc(pSource);
4403           end;
4404         end;
4405       end;
4406       result := true;
4407     end;
4408   end;
4409 end;
4410
4411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4412 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4413 var
4414   bmp: TglBitmap2D;
4415 begin
4416   bmp := TglBitmap2D.Create;
4417   try
4418     bmp.AssignFromSurface(Surface);
4419     result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
4420   finally
4421     bmp.Free;
4422   end;
4423 end;
4424 {$ENDIF}
4425
4426 {$IFDEF GLB_DELPHI}
4427 //TODO rework & test
4428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4429 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4430 var
4431   Row: Integer;
4432   pSource, pData: PByte;
4433 begin
4434   result := false;
4435   if Assigned(Data) then begin
4436     if Assigned(aBitmap) then begin
4437       aBitmap.Width  := Width;
4438       aBitmap.Height := Height;
4439
4440       case Format of
4441         tfAlpha8, ifLuminance, ifDepth8:
4442           begin
4443             Bitmap.PixelFormat := pf8bit;
4444             Bitmap.Palette := CreateGrayPalette;
4445           end;
4446         ifRGB5A1:
4447           Bitmap.PixelFormat := pf15bit;
4448         ifR5G6B5:
4449           Bitmap.PixelFormat := pf16bit;
4450         ifRGB8, ifBGR8:
4451           Bitmap.PixelFormat := pf24bit;
4452         ifRGBA8, ifBGRA8:
4453           Bitmap.PixelFormat := pf32bit;
4454         else
4455           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4456       end;
4457
4458       pSource := Data;
4459       for Row := 0 to FileHeight -1 do begin
4460         pData := Bitmap.Scanline[Row];
4461
4462         Move(pSource^, pData^, fRowSize);
4463         Inc(pSource, fRowSize);
4464
4465         // swap RGB(A) to BGR(A)
4466         if InternalFormat in [ifRGB8, ifRGBA8] then
4467           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4468       end;
4469
4470       result := true;
4471     end;
4472   end;
4473 end;
4474
4475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4476 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4477 var
4478   pSource, pData, pTempData: PByte;
4479   Row, RowSize, TempWidth, TempHeight: Integer;
4480   IntFormat: TglBitmapInternalFormat;
4481 begin
4482   result := false;
4483
4484   if (Assigned(Bitmap)) then begin
4485     case Bitmap.PixelFormat of
4486       pf8bit:
4487         IntFormat := ifLuminance;
4488       pf15bit:
4489         IntFormat := ifRGB5A1;
4490       pf16bit:
4491         IntFormat := ifR5G6B5;
4492       pf24bit:
4493         IntFormat := ifBGR8;
4494       pf32bit:
4495         IntFormat := ifBGRA8;
4496       else
4497         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4498     end;
4499
4500     TempWidth := Bitmap.Width;
4501     TempHeight := Bitmap.Height;
4502
4503     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4504
4505     GetMem(pData, TempHeight * RowSize);
4506     try
4507       pTempData := pData;
4508
4509       for Row := 0 to TempHeight -1 do begin
4510         pSource := Bitmap.Scanline[Row];
4511
4512         if (Assigned(pSource)) then begin
4513           Move(pSource^, pTempData^, RowSize);
4514           Inc(pTempData, RowSize);
4515         end;
4516       end;
4517
4518       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4519
4520       result := true;
4521     except
4522       FreeMem(pData);
4523       raise;
4524     end;
4525   end;
4526 end;
4527
4528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4529 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4530 var
4531   Row, Col, AlphaInterleave: Integer;
4532   pSource, pDest: PByte;
4533 begin
4534   result := false;
4535
4536   if Assigned(Data) then begin
4537     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4538       if Assigned(Bitmap) then begin
4539         Bitmap.PixelFormat := pf8bit;
4540         Bitmap.Palette := CreateGrayPalette;
4541         Bitmap.Width := Width;
4542         Bitmap.Height := Height;
4543
4544         case InternalFormat of
4545           ifLuminanceAlpha:
4546             AlphaInterleave := 1;
4547           ifRGBA8, ifBGRA8:
4548             AlphaInterleave := 3;
4549           else
4550             AlphaInterleave := 0;
4551         end;
4552
4553         // Copy Data
4554         pSource := Data;
4555
4556         for Row := 0 to Height -1 do begin
4557           pDest := Bitmap.Scanline[Row];
4558
4559           if Assigned(pDest) then begin
4560             for Col := 0 to Width -1 do begin
4561               Inc(pSource, AlphaInterleave);
4562               pDest^ := pSource^;
4563               Inc(pDest);
4564               Inc(pSource);
4565             end;
4566           end;
4567         end;
4568
4569         result := true;
4570       end;
4571     end;
4572   end;
4573 end;
4574
4575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4576 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4577 var
4578   tex: TglBitmap2D;
4579 begin
4580   tex := TglBitmap2D.Create;
4581   try
4582     tex.AssignFromBitmap(Bitmap);
4583     result := AddAlphaFromglBitmap(tex, Func, CustomData);
4584   finally
4585     tex.Free;
4586   end;
4587 end;
4588
4589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4590 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
4591   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4592 var
4593   RS: TResourceStream;
4594   TempPos: Integer;
4595   ResTypeStr: String;
4596   TempResType: PChar;
4597 begin
4598   if Assigned(ResType) then
4599     TempResType := ResType
4600   else
4601     begin
4602       TempPos := Pos('.', Resource);
4603       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4604       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
4605       TempResType := PChar(ResTypeStr);
4606     end;
4607
4608   RS := TResourceStream.Create(Instance, Resource, TempResType);
4609   try
4610     result := AddAlphaFromStream(RS, Func, CustomData);
4611   finally
4612     RS.Free;
4613   end;
4614 end;
4615
4616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4617 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4618   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4619 var
4620   RS: TResourceStream;
4621 begin
4622   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4623   try
4624     result := AddAlphaFromStream(RS, Func, CustomData);
4625   finally
4626     RS.Free;
4627   end;
4628 end;
4629 {$ENDIF}
4630
4631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4632 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4633 begin
4634   (* TODO
4635   if not FormatIsUncompressed(InternalFormat) then
4636     raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
4637   *)
4638   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4639 end;
4640
4641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4642 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4643 var
4644   FS: TFileStream;
4645 begin
4646   FS := TFileStream.Create(FileName, fmOpenRead);
4647   try
4648     result := AddAlphaFromStream(FS, aFunc, aArgs);
4649   finally
4650     FS.Free;
4651   end;
4652 end;
4653
4654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4655 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4656 var
4657   tex: TglBitmap2D;
4658 begin
4659   tex := TglBitmap2D.Create(aStream);
4660   try
4661     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4662   finally
4663     tex.Free;
4664   end;
4665 end;
4666
4667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4668 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4669 var
4670   DestData, DestData2, SourceData: pByte;
4671   TempHeight, TempWidth: Integer;
4672   SourceFD, DestFD: TFormatDescriptor;
4673   SourceMD, DestMD, DestMD2: Pointer;
4674
4675   FuncRec: TglBitmapFunctionRec;
4676 begin
4677   result := false;
4678
4679   Assert(Assigned(Data));
4680   Assert(Assigned(aBitmap));
4681   Assert(Assigned(aBitmap.Data));
4682
4683   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
4684     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
4685     if not Assigned(aFunc) then
4686       aFunc := glBitmapAlphaFunc;
4687
4688     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
4689     DestFD   := TFormatDescriptor.Get(Format);
4690
4691     // Values
4692     TempHeight := aBitmap.FileHeight;
4693     TempWidth  := aBitmap.FileWidth;
4694
4695     FuncRec.Sender          := Self;
4696     FuncRec.Args            := aArgs;
4697     FuncRec.Size            := Dimension;
4698     FuncRec.Position.Fields := FuncRec.Size.Fields;
4699     FuncRec.Args            := PtrInt(SourceFD.HasAlpha) and 1;
4700
4701     DestData   := Data;
4702     DestData2  := Data;
4703     SourceData := aBitmap.Data;
4704
4705     // Mapping
4706     SourceFD.PreparePixel(FuncRec.Source);
4707     DestFD.PreparePixel  (FuncRec.Dest);
4708
4709     SourceMD := SourceFD.CreateMappingData;
4710     DestMD   := DestFD.CreateMappingData;
4711     DestMD2  := DestFD.CreateMappingData;
4712     try
4713       FuncRec.Position.Y := 0;
4714       while FuncRec.Position.Y < TempHeight do begin
4715         FuncRec.Position.X := 0;
4716         while FuncRec.Position.X < TempWidth do begin
4717           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4718           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
4719           aFunc(FuncRec);
4720           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
4721           inc(FuncRec.Position.X);
4722         end;
4723         inc(FuncRec.Position.Y);
4724       end;
4725     finally
4726       SourceFD.FreeMappingData(SourceMD);
4727       DestFD.FreeMappingData(DestMD);
4728       DestFD.FreeMappingData(DestMD2);
4729     end;
4730   end;
4731 end;
4732
4733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4734 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
4735 begin
4736   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
4737 end;
4738
4739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4740 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
4741 var
4742   PixelData: TglBitmapPixelData;
4743 begin
4744   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4745   result := AddAlphaFromColorKeyFloat(
4746     aRed   / PixelData.Range.r,
4747     aGreen / PixelData.Range.g,
4748     aBlue  / PixelData.Range.b,
4749     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
4750 end;
4751
4752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4753 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
4754 var
4755   values: array[0..2] of Single;
4756   tmp: Cardinal;
4757   i: Integer;
4758   PixelData: TglBitmapPixelData;
4759 begin
4760   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4761   with PixelData do begin
4762     values[0] := aRed;
4763     values[1] := aGreen;
4764     values[2] := aBlue;
4765
4766     for i := 0 to 2 do begin
4767       tmp          := Trunc(Range.arr[i] * aDeviation);
4768       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
4769       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
4770     end;
4771     Data.a  := 0;
4772     Range.a := 0;
4773   end;
4774   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
4775 end;
4776
4777 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4778 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
4779 begin
4780   result := AddAlphaFromValueFloat(aAlpha / $FF);
4781 end;
4782
4783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4784 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
4785 var
4786   PixelData: TglBitmapPixelData;
4787 begin
4788   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4789   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
4790 end;
4791
4792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4793 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
4794 var
4795   PixelData: TglBitmapPixelData;
4796 begin
4797   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4798   with PixelData do
4799     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
4800   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData.Data.a));
4801 end;
4802
4803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4804 function TglBitmap.RemoveAlpha: Boolean;
4805 var
4806   FormatDesc: TFormatDescriptor;
4807 begin
4808   result := false;
4809   FormatDesc := TFormatDescriptor.Get(Format);
4810   if Assigned(Data) then begin
4811     if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then
4812       raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
4813     result := ConvertTo(FormatDesc.WithoutAlpha);
4814   end;
4815 end;
4816
4817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4818 function TglBitmap.Clone: TglBitmap;
4819 var
4820   Temp: TglBitmap;
4821   TempPtr: PByte;
4822   Size: Integer;
4823 begin
4824   result := nil;
4825   Temp := (ClassType.Create as TglBitmap);
4826   try
4827     // copy texture data if assigned
4828     if Assigned(Data) then begin
4829       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
4830       GetMem(TempPtr, Size);
4831       try
4832         Move(Data^, TempPtr^, Size);
4833         Temp.SetDataPointer(TempPtr, Format, Width, Height);
4834       except
4835         FreeMem(TempPtr);
4836         raise;
4837       end;
4838     end else
4839       Temp.SetDataPointer(nil, Format, Width, Height);
4840
4841         // copy properties
4842     Temp.fID                      := ID;
4843     Temp.fTarget                  := Target;
4844     Temp.fFormat                  := Format;
4845     Temp.fMipMap                  := MipMap;
4846     Temp.fAnisotropic             := Anisotropic;
4847     Temp.fBorderColor             := fBorderColor;
4848     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
4849     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
4850     Temp.fFilterMin               := fFilterMin;
4851     Temp.fFilterMag               := fFilterMag;
4852     Temp.fWrapS                   := fWrapS;
4853     Temp.fWrapT                   := fWrapT;
4854     Temp.fWrapR                   := fWrapR;
4855     Temp.fFilename                := fFilename;
4856     Temp.fCustomName              := fCustomName;
4857     Temp.fCustomNameW             := fCustomNameW;
4858     Temp.fCustomData              := fCustomData;
4859
4860     result := Temp;
4861   except
4862     FreeAndNil(Temp);
4863     raise;
4864   end;
4865 end;
4866
4867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4868 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
4869 var
4870   SourceFD, DestFD: TFormatDescriptor;
4871   SourcePD, DestPD: TglBitmapPixelData;
4872   ShiftData: TShiftData;
4873
4874   function CanCopyDirect: Boolean;
4875   begin
4876     result :=
4877       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
4878       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
4879       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
4880       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
4881   end;
4882
4883   function CanShift: Boolean;
4884   begin
4885     result :=
4886       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
4887       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
4888       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
4889       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
4890   end;
4891
4892   function GetShift(aSource, aDest: Cardinal) : ShortInt;
4893   begin
4894     result := 0;
4895     while (aSource > aDest) and (aSource > 0) do begin
4896       inc(result);
4897       aSource := aSource shr 1;
4898     end;
4899   end;
4900
4901 begin
4902   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
4903     SourceFD := TFormatDescriptor.Get(Format);
4904     DestFD   := TFormatDescriptor.Get(aFormat);
4905
4906     SourceFD.PreparePixel(SourcePD);
4907     DestFD.PreparePixel  (DestPD);
4908
4909     if CanCopyDirect then
4910       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
4911     else if CanShift then begin
4912       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
4913       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
4914       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
4915       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
4916       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@ShiftData));
4917     end else
4918       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
4919   end else
4920     result := true;
4921 end;
4922
4923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4924 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
4925 begin
4926   if aUseRGB or aUseAlpha then
4927     AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
4928 end;
4929
4930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4931 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
4932 begin
4933   fBorderColor[0] := aRed;
4934   fBorderColor[1] := aGreen;
4935   fBorderColor[2] := aBlue;
4936   fBorderColor[3] := aAlpha;
4937   if (ID > 0) then begin
4938     Bind(false);
4939     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
4940   end;
4941 end;
4942
4943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4944 procedure TglBitmap.FreeData;
4945 begin
4946   SetDataPointer(nil, tfEmpty);
4947 end;
4948
4949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4950 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
4951   const aAlpha: Byte);
4952 begin
4953   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
4954 end;
4955
4956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4957 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
4958 var
4959   PixelData: TglBitmapPixelData;
4960 begin
4961   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4962   FillWithColorFloat(
4963     aRed   / PixelData.Range.r,
4964     aGreen / PixelData.Range.g,
4965     aBlue  / PixelData.Range.b,
4966     aAlpha / PixelData.Range.a);
4967 end;
4968
4969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4970 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
4971 var
4972   PixelData: TglBitmapPixelData;
4973 begin
4974   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
4975   with PixelData do begin
4976     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
4977     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
4978     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
4979     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
4980   end;
4981   AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
4982 end;
4983
4984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4985 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
4986 begin
4987   //check MIN filter
4988   case aMin of
4989     GL_NEAREST:
4990       fFilterMin := GL_NEAREST;
4991     GL_LINEAR:
4992       fFilterMin := GL_LINEAR;
4993     GL_NEAREST_MIPMAP_NEAREST:
4994       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
4995     GL_LINEAR_MIPMAP_NEAREST:
4996       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
4997     GL_NEAREST_MIPMAP_LINEAR:
4998       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
4999     GL_LINEAR_MIPMAP_LINEAR:
5000       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5001     else
5002       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5003   end;
5004
5005   //check MAG filter
5006   case aMag of
5007     GL_NEAREST:
5008       fFilterMag := GL_NEAREST;
5009     GL_LINEAR:
5010       fFilterMag := GL_LINEAR;
5011     else
5012       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5013   end;
5014
5015   //apply filter
5016   if (ID > 0) then begin
5017     Bind(false);
5018     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5019
5020     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5021       case fFilterMin of
5022         GL_NEAREST, GL_LINEAR:
5023           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5024         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5025           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5026         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5027           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5028       end;
5029     end else
5030       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5031   end;
5032 end;
5033
5034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5035 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5036
5037   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5038   begin
5039     case aValue of
5040       GL_CLAMP:
5041         aTarget := GL_CLAMP;
5042
5043       GL_REPEAT:
5044         aTarget := GL_REPEAT;
5045
5046       GL_CLAMP_TO_EDGE: begin
5047         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5048           aTarget := GL_CLAMP_TO_EDGE
5049         else
5050           aTarget := GL_CLAMP;
5051       end;
5052
5053       GL_CLAMP_TO_BORDER: begin
5054         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5055           aTarget := GL_CLAMP_TO_BORDER
5056         else
5057           aTarget := GL_CLAMP;
5058       end;
5059
5060       GL_MIRRORED_REPEAT: begin
5061         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5062           aTarget := GL_MIRRORED_REPEAT
5063         else
5064           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5065       end;
5066     else
5067       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5068     end;
5069   end;
5070
5071 begin
5072   CheckAndSetWrap(S, fWrapS);
5073   CheckAndSetWrap(T, fWrapT);
5074   CheckAndSetWrap(R, fWrapR);
5075
5076   if (ID > 0) then begin
5077     Bind(false);
5078     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5079     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5080     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5081   end;
5082 end;
5083
5084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5085 procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
5086 begin
5087   { TODO delete?
5088   if Assigned (fGetPixelFunc) then
5089     fGetPixelFunc(aPos, aPixel);
5090     }
5091 end;
5092
5093 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5094 procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
5095 begin
5096   {TODO delete?
5097   if Assigned (fSetPixelFunc) then
5098     fSetPixelFuc(aPos, aPixel);
5099     }
5100 end;
5101
5102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5103 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5104 begin
5105   if aEnableTextureUnit then
5106     glEnable(Target);
5107   if (ID > 0) then
5108     glBindTexture(Target, ID);
5109 end;
5110
5111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5112 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5113 begin
5114   if aDisableTextureUnit then
5115     glDisable(Target);
5116   glBindTexture(Target, 0);
5117 end;
5118
5119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5120 constructor TglBitmap.Create;
5121 begin
5122 {$IFNDEF GLB_NO_NATIVE_GL}
5123   ReadOpenGLExtensions;
5124 {$ENDIF}
5125   if (ClassType = TglBitmap) then
5126     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5127   inherited Create;
5128 end;
5129
5130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5131 constructor TglBitmap.Create(const aFileName: String);
5132 begin
5133   Create;
5134   LoadFromFile(FileName);
5135 end;
5136
5137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5138 constructor TglBitmap.Create(const aStream: TStream);
5139 begin
5140   Create;
5141   LoadFromStream(aStream);
5142 end;
5143
5144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5145 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5146 var
5147   Image: PByte;
5148   ImageSize: Integer;
5149 begin
5150   Create;
5151   TFormatDescriptor.Get(aFormat).GetSize(aSize);
5152   GetMem(Image, ImageSize);
5153   try
5154     FillChar(Image^, ImageSize, #$FF);
5155     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5156   except
5157     FreeMem(Image);
5158     raise;
5159   end;
5160 end;
5161
5162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5163 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5164   const aFunc: TglBitmapFunction; const aArgs: PtrInt);
5165 begin
5166   Create;
5167   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5168 end;
5169
5170 {$IFDEF GLB_DELPHI}
5171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5172 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5173 begin
5174   Create;
5175   LoadFromResource(aInstance, aResource, aResType);
5176 end;
5177
5178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5179 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5180 begin
5181   Create;
5182   LoadFromResourceID(aInstance, aResourceID, aResType);
5183 end;
5184 {$ENDIF}
5185
5186 {$IFDEF GLB_SUPPORT_PNG_READ}
5187 {$IF DEFINED(GLB_SDL_IMAGE)}
5188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5189 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5191 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5192 var
5193   Surface: PSDL_Surface;
5194   RWops: PSDL_RWops;
5195 begin
5196   result := false;
5197   RWops := glBitmapCreateRWops(aStream);
5198   try
5199     if IMG_isPNG(RWops) > 0 then begin
5200       Surface := IMG_LoadPNG_RW(RWops);
5201       try
5202         AssignFromSurface(Surface);
5203         Rresult := true;
5204       finally
5205         SDL_FreeSurface(Surface);
5206       end;
5207     end;
5208   finally
5209     SDL_FreeRW(RWops);
5210   end;
5211 end;
5212
5213 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5215 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5216 begin
5217   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5218 end;
5219
5220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5221 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5222 var
5223   StreamPos: Int64;
5224   signature: array [0..7] of byte;
5225   png: png_structp;
5226   png_info: png_infop;
5227
5228   TempHeight, TempWidth: Integer;
5229   Format: TglBitmapInternalFormat;
5230
5231   png_data: pByte;
5232   png_rows: array of pByte;
5233   Row, LineSize: Integer;
5234 begin
5235   result := false;
5236
5237   if not init_libPNG then
5238     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5239
5240   try
5241     // signature
5242     StreamPos := Stream.Position;
5243     Stream.Read(signature, 8);
5244     Stream.Position := StreamPos;
5245
5246     if png_check_sig(@signature, 8) <> 0 then begin
5247       // png read struct
5248       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5249       if png = nil then
5250         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5251
5252       // png info
5253       png_info := png_create_info_struct(png);
5254       if png_info = nil then begin
5255         png_destroy_read_struct(@png, nil, nil);
5256         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5257       end;
5258
5259       // set read callback
5260       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
5261
5262       // read informations
5263       png_read_info(png, png_info);
5264
5265       // size
5266       TempHeight := png_get_image_height(png, png_info);
5267       TempWidth := png_get_image_width(png, png_info);
5268
5269       // format
5270       case png_get_color_type(png, png_info) of
5271         PNG_COLOR_TYPE_GRAY:
5272           Format := tfLuminance8;
5273         PNG_COLOR_TYPE_GRAY_ALPHA:
5274           Format := tfLuminance8Alpha8;
5275         PNG_COLOR_TYPE_RGB:
5276           Format := tfRGB8;
5277         PNG_COLOR_TYPE_RGB_ALPHA:
5278           Format := tfRGBA8;
5279         else
5280           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5281       end;
5282
5283       // cut upper 8 bit from 16 bit formats
5284       if png_get_bit_depth(png, png_info) > 8 then
5285         png_set_strip_16(png);
5286
5287       // expand bitdepth smaller than 8
5288       if png_get_bit_depth(png, png_info) < 8 then
5289         png_set_expand(png);
5290
5291       // allocating mem for scanlines
5292       LineSize := png_get_rowbytes(png, png_info);
5293       GetMem(png_data, TempHeight * LineSize);
5294       try
5295         SetLength(png_rows, TempHeight);
5296         for Row := Low(png_rows) to High(png_rows) do begin
5297           png_rows[Row] := png_data;
5298           Inc(png_rows[Row], Row * LineSize);
5299         end;
5300
5301         // read complete image into scanlines
5302         png_read_image(png, @png_rows[0]);
5303
5304         // read end
5305         png_read_end(png, png_info);
5306
5307         // destroy read struct
5308         png_destroy_read_struct(@png, @png_info, nil);
5309
5310         SetLength(png_rows, 0);
5311
5312         // set new data
5313         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5314
5315         result := true;
5316       except
5317         FreeMem(png_data);
5318         raise;
5319       end;
5320     end;
5321   finally
5322     quit_libPNG;
5323   end;
5324 end;
5325
5326 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5328 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5329 var
5330   StreamPos: Int64;
5331   Png: TPNGObject;
5332   Header: Array[0..7] of Byte;
5333   Row, Col, PixSize, LineSize: Integer;
5334   NewImage, pSource, pDest, pAlpha: pByte;
5335   Format: TglBitmapInternalFormat;
5336
5337 const
5338   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
5339
5340 begin
5341   result := false;
5342
5343   StreamPos := Stream.Position;
5344   Stream.Read(Header[0], SizeOf(Header));
5345   Stream.Position := StreamPos;
5346
5347   {Test if the header matches}
5348   if Header = PngHeader then begin
5349     Png := TPNGObject.Create;
5350     try
5351       Png.LoadFromStream(Stream);
5352
5353       case Png.Header.ColorType of
5354         COLOR_GRAYSCALE:
5355           Format := ifLuminance;
5356         COLOR_GRAYSCALEALPHA:
5357           Format := ifLuminanceAlpha;
5358         COLOR_RGB:
5359           Format := ifBGR8;
5360         COLOR_RGBALPHA:
5361           Format := ifBGRA8;
5362         else
5363           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5364       end;
5365
5366       PixSize := Trunc(FormatGetSize(Format));
5367       LineSize := Integer(Png.Header.Width) * PixSize;
5368
5369       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5370       try
5371         pDest := NewImage;
5372
5373         case Png.Header.ColorType of
5374           COLOR_RGB, COLOR_GRAYSCALE:
5375             begin
5376               for Row := 0 to Png.Height -1 do begin
5377                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5378                 Inc(pDest, LineSize);
5379               end;
5380             end;
5381           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5382             begin
5383               PixSize := PixSize -1;
5384
5385               for Row := 0 to Png.Height -1 do begin
5386                 pSource := Png.Scanline[Row];
5387                 pAlpha := pByte(Png.AlphaScanline[Row]);
5388
5389                 for Col := 0 to Png.Width -1 do begin
5390                   Move (pSource^, pDest^, PixSize);
5391                   Inc(pSource, PixSize);
5392                   Inc(pDest, PixSize);
5393
5394                   pDest^ := pAlpha^;
5395                   inc(pAlpha);
5396                   Inc(pDest);
5397                 end;
5398               end;
5399             end;
5400           else
5401             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5402         end;
5403
5404         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
5405
5406         result := true;
5407       except
5408         FreeMem(NewImage);
5409         raise;
5410       end;
5411     finally
5412       Png.Free;
5413     end;
5414   end;
5415 end;
5416 {$IFEND}
5417 {$ENDIF}
5418
5419 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5420 {$IFDEF GLB_LIB_PNG}
5421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5422 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5423 begin
5424   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5425 end;
5426 {$ENDIF}
5427
5428 {$IF DEFINED(GLB_LIB_PNG)}
5429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5430 procedure TglBitmap.SavePNG(const aStream: TStream);
5431 var
5432   png: png_structp;
5433   png_info: png_infop;
5434   png_rows: array of pByte;
5435   LineSize: Integer;
5436   ColorType: Integer;
5437   Row: Integer;
5438 begin
5439   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5440     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5441
5442   if not init_libPNG then
5443     raise Exception.Create('SavePNG - unable to initialize libPNG.');
5444
5445   try
5446     case FInternalFormat of
5447       ifAlpha, ifLuminance, ifDepth8:
5448         ColorType := PNG_COLOR_TYPE_GRAY;
5449       ifLuminanceAlpha:
5450         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5451       ifBGR8, ifRGB8:
5452         ColorType := PNG_COLOR_TYPE_RGB;
5453       ifBGRA8, ifRGBA8:
5454         ColorType := PNG_COLOR_TYPE_RGBA;
5455       else
5456         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5457     end;
5458     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
5459
5460     // creating array for scanline
5461     SetLength(png_rows, Height);
5462     try
5463       for Row := 0 to Height - 1 do begin
5464         png_rows[Row] := Data;
5465         Inc(png_rows[Row], Row * LineSize)
5466       end;
5467
5468       // write struct
5469       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5470       if png = nil then
5471         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5472
5473       // create png info
5474       png_info := png_create_info_struct(png);
5475       if png_info = nil then begin
5476         png_destroy_write_struct(@png, nil);
5477         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5478       end;
5479
5480       // set read callback
5481       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
5482
5483       // set compression
5484       png_set_compression_level(png, 6);
5485
5486       if InternalFormat in [ifBGR8, ifBGRA8] then
5487         png_set_bgr(png);
5488
5489       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5490       png_write_info(png, png_info);
5491       png_write_image(png, @png_rows[0]);
5492       png_write_end(png, png_info);
5493       png_destroy_write_struct(@png, @png_info);
5494     finally
5495       SetLength(png_rows, 0);
5496     end;
5497   finally
5498     quit_libPNG;
5499   end;
5500 end;
5501
5502 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5504 procedure TglBitmap.SavePNG(const aStream: TStream);
5505 var
5506   Png: TPNGObject;
5507
5508   pSource, pDest: pByte;
5509   X, Y, PixSize: Integer;
5510   ColorType: Cardinal;
5511   Alpha: Boolean;
5512
5513   pTemp: pByte;
5514   Temp: Byte;
5515 begin
5516   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5517     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5518
5519   case FInternalFormat of
5520     ifAlpha, ifLuminance, ifDepth8: begin
5521       ColorType := COLOR_GRAYSCALE;
5522       PixSize := 1;
5523       Alpha := false;
5524     end;
5525     ifLuminanceAlpha: begin
5526       ColorType := COLOR_GRAYSCALEALPHA;
5527       PixSize := 1;
5528       Alpha := true;
5529     end;
5530     ifBGR8, ifRGB8: begin
5531       ColorType := COLOR_RGB;
5532       PixSize := 3;
5533       Alpha := false;
5534     end;
5535     ifBGRA8, ifRGBA8: begin
5536       ColorType := COLOR_RGBALPHA;
5537       PixSize := 3;
5538       Alpha := true
5539     end;
5540   else
5541     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5542   end;
5543
5544   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5545   try
5546     // Copy ImageData
5547     pSource := Data;
5548     for Y := 0 to Height -1 do begin
5549       pDest := png.ScanLine[Y];
5550       for X := 0 to Width -1 do begin
5551         Move(pSource^, pDest^, PixSize);
5552         Inc(pDest, PixSize);
5553         Inc(pSource, PixSize);
5554         if Alpha then begin
5555           png.AlphaScanline[Y]^[X] := pSource^;
5556           Inc(pSource);
5557         end;
5558       end;
5559
5560       // convert RGB line to BGR
5561       if InternalFormat in [ifRGB8, ifRGBA8] then begin
5562         pTemp := png.ScanLine[Y];
5563         for X := 0 to Width -1 do begin
5564           Temp := pByteArray(pTemp)^[0];
5565           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5566           pByteArray(pTemp)^[2] := Temp;
5567           Inc(pTemp, 3);
5568         end;
5569       end;
5570     end;
5571
5572     // Save to Stream
5573     Png.CompressionLevel := 6;
5574     Png.SaveToStream(Stream);
5575   finally
5576     FreeAndNil(Png);
5577   end;
5578 end;
5579 {$IFEND}
5580 {$ENDIF}
5581
5582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5583 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5585 {$IFDEF GLB_LIB_JPEG}
5586 type
5587   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5588   glBitmap_libJPEG_source_mgr = record
5589     pub: jpeg_source_mgr;
5590
5591     SrcStream: TStream;
5592     SrcBuffer: array [1..4096] of byte;
5593   end;
5594
5595   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5596   glBitmap_libJPEG_dest_mgr = record
5597     pub: jpeg_destination_mgr;
5598
5599     DestStream: TStream;
5600     DestBuffer: array [1..4096] of byte;
5601   end;
5602
5603 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5604 {
5605 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5606 var
5607   Msg: String;
5608 begin
5609   SetLength(Msg, 256);
5610   cinfo^.err^.format_message(cinfo, pChar(Msg));
5611   Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
5612   cinfo^.global_state := 0;
5613   jpeg_abort(cinfo);
5614 end;
5615 }
5616
5617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5618 {
5619 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5620 var
5621   Msg: String;
5622 begin
5623   SetLength(Msg, 256);
5624   cinfo^.err^.format_message(cinfo, pChar(Msg));
5625   Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
5626   cinfo^.global_state := 0;
5627 end;
5628 }
5629
5630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5631 {
5632 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5633 begin
5634 end;
5635 }
5636
5637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5638 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5639 var
5640   src: glBitmap_libJPEG_source_mgr_ptr;
5641   bytes: integer;
5642 begin
5643   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5644
5645   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5646         if (bytes <= 0) then begin
5647                 src^.SrcBuffer[1] := $FF;
5648                 src^.SrcBuffer[2] := JPEG_EOI;
5649                 bytes := 2;
5650         end;
5651
5652         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5653         src^.pub.bytes_in_buffer := bytes;
5654
5655   result := true;
5656 end;
5657
5658 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5659 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5660 var
5661   src: glBitmap_libJPEG_source_mgr_ptr;
5662 begin
5663   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5664
5665   if num_bytes > 0 then begin
5666     // wanted byte isn't in buffer so set stream position and read buffer
5667     if num_bytes > src^.pub.bytes_in_buffer then begin
5668       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5669       src^.pub.fill_input_buffer(cinfo);
5670     end else begin
5671       // wanted byte is in buffer so only skip
5672                 inc(src^.pub.next_input_byte, num_bytes);
5673                 dec(src^.pub.bytes_in_buffer, num_bytes);
5674     end;
5675   end;
5676 end;
5677
5678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5679 {
5680 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5681 begin
5682 end;
5683 }
5684
5685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5686 {
5687 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5688 begin
5689 end;
5690 }
5691
5692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5693 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5694 var
5695   dest: glBitmap_libJPEG_dest_mgr_ptr;
5696 begin
5697   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5698
5699   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5700     // write complete buffer
5701     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5702
5703     // reset buffer
5704     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5705     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5706   end;
5707
5708   result := true;
5709 end;
5710
5711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5712 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5713 var
5714   Idx: Integer;
5715   dest: glBitmap_libJPEG_dest_mgr_ptr;
5716 begin
5717   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5718
5719   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5720     // check for endblock
5721     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5722       // write endblock
5723       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5724
5725       // leave
5726       break;
5727     end else
5728       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5729   end;
5730 end;
5731 {$ENDIF}
5732
5733 {$IFDEF GLB_SUPPORT_JPEG_READ}
5734 {$IF DEFINED(GLB_SDL_IMAGE)}
5735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5736 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
5737 var
5738   Surface: PSDL_Surface;
5739   RWops: PSDL_RWops;
5740 begin
5741   result := false;
5742
5743   RWops := glBitmapCreateRWops(Stream);
5744   try
5745     if IMG_isJPG(RWops) > 0 then begin
5746       Surface := IMG_LoadJPG_RW(RWops);
5747       try
5748         AssignFromSurface(Surface);
5749         result := true;
5750       finally
5751         SDL_FreeSurface(Surface);
5752       end;
5753     end;
5754   finally
5755     SDL_FreeRW(RWops);
5756   end;
5757 end;
5758
5759 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5761 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
5762 var
5763   StreamPos: Int64;
5764   Temp: array[0..1]of Byte;
5765
5766   jpeg: jpeg_decompress_struct;
5767   jpeg_err: jpeg_error_mgr;
5768
5769   IntFormat: TglBitmapInternalFormat;
5770   pImage: pByte;
5771   TempHeight, TempWidth: Integer;
5772
5773   pTemp: pByte;
5774   Row: Integer;
5775 begin
5776   result := false;
5777
5778   if not init_libJPEG then
5779     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
5780
5781   try
5782     // reading first two bytes to test file and set cursor back to begin
5783     StreamPos := Stream.Position;
5784     Stream.Read(Temp[0], 2);
5785     Stream.Position := StreamPos;
5786
5787     // if Bitmap then read file.
5788     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5789       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
5790       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
5791
5792       // error managment
5793       jpeg.err := jpeg_std_error(@jpeg_err);
5794       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
5795       jpeg_err.output_message := glBitmap_libJPEG_output_message;
5796
5797       // decompression struct
5798       jpeg_create_decompress(@jpeg);
5799
5800       // allocation space for streaming methods
5801       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
5802
5803       // seeting up custom functions
5804       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
5805         pub.init_source       := glBitmap_libJPEG_init_source;
5806         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
5807         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
5808         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
5809         pub.term_source       := glBitmap_libJPEG_term_source;
5810
5811         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
5812         pub.next_input_byte := nil;   // until buffer loaded
5813
5814         SrcStream := Stream;
5815       end;
5816
5817       // set global decoding state
5818       jpeg.global_state := DSTATE_START;
5819
5820       // read header of jpeg
5821       jpeg_read_header(@jpeg, false);
5822
5823       // setting output parameter
5824       case jpeg.jpeg_color_space of
5825         JCS_GRAYSCALE:
5826           begin
5827             jpeg.out_color_space := JCS_GRAYSCALE;
5828             IntFormat := ifLuminance;
5829           end;
5830         else
5831           jpeg.out_color_space := JCS_RGB;
5832           IntFormat := ifRGB8;
5833       end;
5834
5835       // reading image
5836       jpeg_start_decompress(@jpeg);
5837
5838       TempHeight := jpeg.output_height;
5839       TempWidth := jpeg.output_width;
5840
5841       // creating new image
5842       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
5843       try
5844         pTemp := pImage;
5845
5846         for Row := 0 to TempHeight -1 do begin
5847           jpeg_read_scanlines(@jpeg, @pTemp, 1);
5848           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
5849         end;
5850
5851         // finish decompression
5852         jpeg_finish_decompress(@jpeg);
5853
5854         // destroy decompression
5855         jpeg_destroy_decompress(@jpeg);
5856
5857         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
5858
5859         result := true;
5860       except
5861         FreeMem(pImage);
5862         raise;
5863       end;
5864     end;
5865   finally
5866     quit_libJPEG;
5867   end;
5868 end;
5869
5870 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5871 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5872 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
5873 var
5874   bmp: TBitmap;
5875   jpg: TJPEGImage;
5876   StreamPos: Int64;
5877   Temp: array[0..1]of Byte;
5878 begin
5879   result := false;
5880
5881   // reading first two bytes to test file and set cursor back to begin
5882   StreamPos := Stream.Position;
5883   Stream.Read(Temp[0], 2);
5884   Stream.Position := StreamPos;
5885
5886   // if Bitmap then read file.
5887   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5888     bmp := TBitmap.Create;
5889     try
5890       jpg := TJPEGImage.Create;
5891       try
5892         jpg.LoadFromStream(Stream);
5893         bmp.Assign(jpg);
5894         result := AssignFromBitmap(bmp);
5895       finally
5896         jpg.Free;
5897       end;
5898     finally
5899       bmp.Free;
5900     end;
5901   end;
5902 end;
5903 {$IFEND}
5904 {$ENDIF}
5905
5906 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5907 {$IF DEFEFINED(GLB_LIB_JPEG)}
5908 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5909 procedure TglBitmap.SaveJPEG(Stream: TStream);
5910 var
5911   jpeg: jpeg_compress_struct;
5912   jpeg_err: jpeg_error_mgr;
5913   Row: Integer;
5914   pTemp, pTemp2: pByte;
5915
5916   procedure CopyRow(pDest, pSource: pByte);
5917   var
5918     X: Integer;
5919   begin
5920     for X := 0 to Width - 1 do begin
5921       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5922       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5923       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5924       Inc(pDest, 3);
5925       Inc(pSource, 3);
5926     end;
5927   end;
5928
5929 begin
5930   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5931     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
5932
5933   if not init_libJPEG then
5934     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5935
5936   try
5937     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
5938     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
5939
5940     // error managment
5941     jpeg.err := jpeg_std_error(@jpeg_err);
5942     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
5943     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5944
5945     // compression struct
5946     jpeg_create_compress(@jpeg);
5947
5948     // allocation space for streaming methods
5949     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5950
5951     // seeting up custom functions
5952     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5953       pub.init_destination    := glBitmap_libJPEG_init_destination;
5954       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5955       pub.term_destination    := glBitmap_libJPEG_term_destination;
5956
5957       pub.next_output_byte  := @DestBuffer[1];
5958       pub.free_in_buffer    := Length(DestBuffer);
5959
5960       DestStream := Stream;
5961     end;
5962
5963     // very important state
5964     jpeg.global_state := CSTATE_START;
5965     jpeg.image_width  := Width;
5966     jpeg.image_height := Height;
5967     case InternalFormat of
5968       ifAlpha, ifLuminance, ifDepth8: begin
5969         jpeg.input_components := 1;
5970         jpeg.in_color_space := JCS_GRAYSCALE;
5971       end;
5972       ifRGB8, ifBGR8: begin
5973         jpeg.input_components := 3;
5974         jpeg.in_color_space := JCS_RGB;
5975       end;
5976     end;
5977
5978     jpeg_set_defaults(@jpeg);
5979     jpeg_set_quality(@jpeg, 95, true);
5980     jpeg_start_compress(@jpeg, true);
5981     pTemp := Data;
5982
5983     if InternalFormat = ifBGR8 then
5984       GetMem(pTemp2, fRowSize)
5985     else
5986       pTemp2 := pTemp;
5987
5988     try
5989       for Row := 0 to jpeg.image_height -1 do begin
5990         // prepare row
5991         if InternalFormat = ifBGR8 then
5992           CopyRow(pTemp2, pTemp)
5993         else
5994           pTemp2 := pTemp;
5995
5996         // write row
5997         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5998         inc(pTemp, fRowSize);
5999       end;
6000     finally
6001       // free memory
6002       if InternalFormat = ifBGR8 then
6003         FreeMem(pTemp2);
6004     end;
6005     jpeg_finish_compress(@jpeg);
6006     jpeg_destroy_compress(@jpeg);
6007   finally
6008     quit_libJPEG;
6009   end;
6010 end;
6011
6012 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6014 procedure TglBitmap.SaveJPEG(Stream: TStream);
6015 var
6016   Bmp: TBitmap;
6017   Jpg: TJPEGImage;
6018 begin
6019   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6020     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6021
6022   Bmp := TBitmap.Create;
6023   try
6024     Jpg := TJPEGImage.Create;
6025     try
6026       AssignToBitmap(Bmp);
6027       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6028         Jpg.Grayscale := true;
6029         Jpg.PixelFormat := jf8Bit;
6030       end;
6031       Jpg.Assign(Bmp);
6032       Jpg.SaveToStream(Stream);
6033     finally
6034       FreeAndNil(Jpg);
6035     end;
6036   finally
6037     FreeAndNil(Bmp);
6038   end;
6039 end;
6040 {$ENDIF}
6041 {$ENDIF}
6042
6043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6044 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6046 const
6047   BMP_MAGIC          = $4D42;
6048
6049   BMP_COMP_RGB       = 0;
6050   BMP_COMP_RLE8      = 1;
6051   BMP_COMP_RLE4      = 2;
6052   BMP_COMP_BITFIELDS = 3;
6053
6054 type
6055   TBMPHeader = packed record
6056     bfType: Word;
6057     bfSize: Cardinal;
6058     bfReserved1: Word;
6059     bfReserved2: Word;
6060     bfOffBits: Cardinal;
6061   end;
6062
6063   TBMPInfo = packed record
6064     biSize: Cardinal;
6065     biWidth: Longint;
6066     biHeight: Longint;
6067     biPlanes: Word;
6068     biBitCount: Word;
6069     biCompression: Cardinal;
6070     biSizeImage: Cardinal;
6071     biXPelsPerMeter: Longint;
6072     biYPelsPerMeter: Longint;
6073     biClrUsed: Cardinal;
6074     biClrImportant: Cardinal;
6075   end;
6076
6077 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6078 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6079
6080   //////////////////////////////////////////////////////////////////////////////////////////////////
6081   function ReadInfo(var aInfo: TBMPInfo; var aMask: TglBitmapColorRec): TglBitmapFormat;
6082   begin
6083     result := tfEmpty;
6084     aStream.Read(aInfo, SizeOf(aInfo));
6085     FillChar(aMask, SizeOf(aMask), 0);
6086
6087     //Read Compression
6088     case aInfo.biCompression of
6089       BMP_COMP_RLE4,
6090       BMP_COMP_RLE8: begin
6091         raise EglBitmapException.Create('RLE compression is not supported');
6092       end;
6093       BMP_COMP_BITFIELDS: begin
6094         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6095           aStream.Read(aMask.r, SizeOf(aMask.r));
6096           aStream.Read(aMask.g, SizeOf(aMask.g));
6097           aStream.Read(aMask.b, SizeOf(aMask.b));
6098           aStream.Read(aMask.a, SizeOf(aMask.a));
6099         end else
6100           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6101       end;
6102     end;
6103
6104     //get suitable format
6105     case aInfo.biBitCount of
6106        8: result := tfLuminance8;
6107       16: result := tfBGR5;
6108       24: result := tfBGR8;
6109       32: result := tfBGRA8;
6110     end;
6111   end;
6112
6113   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6114   var
6115     i, c: Integer;
6116     ColorTable: TbmpColorTable;
6117   begin
6118     result := nil;
6119     if (aInfo.biBitCount >= 16) then
6120       exit;
6121     aFormat := tfLuminance8;
6122     c := aInfo.biClrUsed;
6123     if (c = 0) then
6124       c := 1 shl aInfo.biBitCount;
6125     SetLength(ColorTable, c);
6126     for i := 0 to c-1 do begin
6127       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6128       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6129         aFormat := tfRGB8;
6130     end;
6131
6132     result := TbmpColorTableFormat.Create;
6133     result.PixelSize  := aInfo.biBitCount / 8;
6134     result.ColorTable := ColorTable;
6135     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6136   end;
6137
6138   //////////////////////////////////////////////////////////////////////////////////////////////////
6139   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6140     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6141   var
6142     TmpFormat: TglBitmapFormat;
6143     FormatDesc: TFormatDescriptor;
6144   begin
6145     result := nil;
6146     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6147       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6148         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6149         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6150           aFormat := FormatDesc.Format;
6151           exit;
6152         end;
6153       end;
6154
6155       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6156         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6157       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6158         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6159
6160       result := TbmpBitfieldFormat.Create;
6161       result.PixelSize := aInfo.biBitCount / 8;
6162       result.RedMask   := aMask.r;
6163       result.GreenMask := aMask.g;
6164       result.BlueMask  := aMask.b;
6165       result.AlphaMask := aMask.a;
6166     end;
6167   end;
6168
6169 var
6170   //simple types
6171   StartPos: Int64;
6172   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6173   PaddingBuff: Cardinal;
6174   LineBuf, ImageData, TmpData: PByte;
6175   SourceMD, DestMD: Pointer;
6176   BmpFormat: TglBitmapFormat;
6177   ColorTable: TbmpColorTable;
6178
6179   //records
6180   Mask: TglBitmapColorRec;
6181   Header: TBMPHeader;
6182   Info: TBMPInfo;
6183
6184   //classes
6185   SpecialFormat: TFormatDescriptor;
6186   FormatDesc: TFormatDescriptor;
6187
6188   //////////////////////////////////////////////////////////////////////////////////////////////////
6189   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6190   var
6191     i, j: Integer;
6192     Pixel: TglBitmapPixelData;
6193   begin
6194     aStream.Read(aLineBuf^, rbLineSize);
6195     SpecialFormat.PreparePixel(Pixel);
6196     for i := 0 to Info.biWidth-1 do begin
6197       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6198       with FormatDesc do begin
6199         //TODO: use convert function
6200         for j := 0 to 3 do
6201           if (SpecialFormat.Range.arr[j] <> Range.arr[j]) then begin
6202             if (SpecialFormat.Range.arr[j] > 0) then
6203               Pixel.Data.arr[j] := Round(Pixel.Data.arr[j] / SpecialFormat.Range.arr[j] * Range.arr[j])
6204             else
6205               Pixel.Data.arr[j] := 0;
6206           end;
6207       end;
6208       FormatDesc.Map(Pixel, aData, DestMD);
6209     end;
6210   end;
6211
6212 begin
6213   result        := false;
6214   BmpFormat     := tfEmpty;
6215   SpecialFormat := nil;
6216   LineBuf       := nil;
6217   SourceMD      := nil;
6218   DestMD        := nil;
6219
6220   // Header
6221   StartPos := aStream.Position;
6222   aStream.Read(Header, SizeOf(Header));
6223
6224   if Header.bfType = BMP_MAGIC then begin
6225     try try
6226       BmpFormat        := ReadInfo(Info, Mask);
6227       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6228       if not Assigned(SpecialFormat) then
6229         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6230       aStream.Position := StartPos + Header.bfOffBits;
6231
6232       if (BmpFormat <> tfEmpty) then begin
6233         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6234         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6235         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6236         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6237
6238         //get Memory
6239         DestMD    := FormatDesc.CreateMappingData;
6240         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6241         GetMem(ImageData, ImageSize);
6242         if Assigned(SpecialFormat) then begin
6243           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6244           SourceMD := SpecialFormat.CreateMappingData;
6245         end;
6246
6247         //read Data
6248         try try
6249           FillChar(ImageData^, ImageSize, $FF);
6250           TmpData := ImageData;
6251           if (Info.biHeight > 0) then
6252             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6253           for i := 0 to Abs(Info.biHeight)-1 do begin
6254             if Assigned(SpecialFormat) then
6255               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6256             else
6257               aStream.Read(TmpData^, wbLineSize);   //else only read data
6258             if (Info.biHeight > 0) then
6259               dec(TmpData, wbLineSize)
6260             else
6261               inc(TmpData, wbLineSize);
6262             aStream.Read(PaddingBuff, Padding);
6263           end;
6264           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6265           result := true;
6266         finally
6267           if Assigned(LineBuf) then
6268             FreeMem(LineBuf);
6269           if Assigned(SourceMD) then
6270             SpecialFormat.FreeMappingData(SourceMD);
6271           FormatDesc.FreeMappingData(DestMD);
6272         end;
6273         except
6274           FreeMem(ImageData);
6275           raise;
6276         end;
6277       end else
6278         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6279     except
6280       aStream.Position := StartPos;
6281       raise;
6282     end;
6283     finally
6284       FreeAndNil(SpecialFormat);
6285     end;
6286   end
6287     else aStream.Position := StartPos;
6288 end;
6289
6290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6291 procedure TglBitmap.SaveBMP(const aStream: TStream);
6292 var
6293   Header: TBMPHeader;
6294   Info: TBMPInfo;
6295   Converter: TbmpColorTableFormat;
6296   FormatDesc: TFormatDescriptor;
6297   SourceFD, DestFD: Pointer;
6298   pData, srcData, dstData, ConvertBuffer: pByte;
6299
6300   Pixel: TglBitmapPixelData;
6301   PixelFormat: TglBitmapPixelData;
6302   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx, i: Integer;
6303   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6304
6305   PaddingBuff: Cardinal;
6306
6307   function GetLineWidth : Integer;
6308   begin
6309     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6310   end;
6311
6312 begin
6313   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6314     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6315
6316   Converter  := nil;
6317   FormatDesc := TFormatDescriptor.Get(Format);
6318   ImageSize  := FormatDesc.GetSize(Dimension);
6319
6320   FillChar(Header, SizeOf(Header), 0);
6321   Header.bfType      := BMP_MAGIC;
6322   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6323   Header.bfReserved1 := 0;
6324   Header.bfReserved2 := 0;
6325   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6326
6327   FillChar(Info, SizeOf(Info), 0);
6328   Info.biSize        := SizeOf(Info);
6329   Info.biWidth       := Width;
6330   Info.biHeight      := Height;
6331   Info.biPlanes      := 1;
6332   Info.biCompression := BMP_COMP_RGB;
6333   Info.biSizeImage   := ImageSize;
6334
6335   try
6336     case Format of
6337       tfLuminance4: begin
6338         Info.biBitCount  := 4;
6339         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6340         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6341         Converter           := TbmpColorTableFormat.Create;
6342         Converter.PixelSize := 0.5;
6343         Converter.Format    := Format;
6344         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6345         Converter.CreateColorTable;
6346       end;
6347
6348       tfR3G3B2, tfLuminance8: begin
6349         Info.biBitCount  :=  8;
6350         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6351         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6352         Converter           := TbmpColorTableFormat.Create;
6353         Converter.PixelSize := 1;
6354         Converter.Format    := Format;
6355         if (Format = tfR3G3B2) then begin
6356           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6357           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6358         end else
6359           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6360         Converter.CreateColorTable;
6361       end;
6362
6363       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6364       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6365         Info.biBitCount    := 16;
6366         Info.biCompression := BMP_COMP_BITFIELDS;
6367       end;
6368
6369       tfBGR8, tfRGB8: begin
6370         Info.biBitCount := 24;
6371       end;
6372
6373       tfRGB10, tfRGB10A2, tfRGBA8,
6374       tfBGR10, tfBGR10A2, tfBGRA8: begin
6375         Info.biBitCount    := 32;
6376         Info.biCompression := BMP_COMP_BITFIELDS;
6377       end;
6378     else
6379       raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6380     end;
6381     Info.biXPelsPerMeter := 2835;
6382     Info.biYPelsPerMeter := 2835;
6383
6384     // prepare bitmasks
6385     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6386       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6387       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6388
6389       RedMask    := FormatDesc.RedMask;
6390       GreenMask  := FormatDesc.GreenMask;
6391       BlueMask   := FormatDesc.BlueMask;
6392       AlphaMask  := FormatDesc.AlphaMask;
6393     end;
6394
6395     // headers
6396     aStream.Write(Header, SizeOf(Header));
6397     aStream.Write(Info, SizeOf(Info));
6398
6399     // colortable
6400     if Assigned(Converter) then
6401       aStream.Write(Converter.ColorTable[0].b,
6402         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6403
6404     // bitmasks
6405     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6406       aStream.Write(RedMask,   SizeOf(Cardinal));
6407       aStream.Write(GreenMask, SizeOf(Cardinal));
6408       aStream.Write(BlueMask,  SizeOf(Cardinal));
6409       aStream.Write(AlphaMask, SizeOf(Cardinal));
6410     end;
6411
6412     // image data
6413     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6414     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6415     Padding     := GetLineWidth - wbLineSize;
6416     PaddingBuff := 0;
6417
6418     pData := Data;
6419     inc(pData, (Height-1) * rbLineSize);
6420
6421     // prepare row buffer. But only for RGB because RGBA supports color masks
6422     // so it's possible to change color within the image.
6423     if Assigned(Converter) then begin
6424       FormatDesc.PreparePixel(Pixel);
6425       GetMem(ConvertBuffer, wbLineSize);
6426       SourceFD := FormatDesc.CreateMappingData;
6427       DestFD   := Converter.CreateMappingData;
6428     end else
6429       ConvertBuffer := nil;
6430
6431     try
6432       for LineIdx := 0 to Height - 1 do begin
6433         // preparing row
6434         if Assigned(Converter) then begin
6435           srcData := pData;
6436           dstData := ConvertBuffer;
6437           for PixelIdx := 0 to Info.biWidth-1 do begin
6438             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6439             with FormatDesc do begin
6440               //TODO use convert function
6441               for i := 0 to 3 do
6442                 if (Converter.Range.arr[i] <> Range.arr[i]) then begin
6443                   if (Range.arr[i] > 0) then
6444                     Pixel.Data.arr[i] := Round(Pixel.Data.arr[i] / Range.arr[i] * Converter.Range.arr[i])
6445                   else
6446                     Pixel.Data.arr[i] := 0;
6447                 end;
6448             end;
6449             Converter.Map(Pixel, dstData, DestFD);
6450           end;
6451           aStream.Write(ConvertBuffer^, wbLineSize);
6452         end else begin
6453           aStream.Write(pData^, rbLineSize);
6454         end;
6455         dec(pData, rbLineSize);
6456         if (Padding > 0) then
6457           aStream.Write(PaddingBuff, Padding);
6458       end;
6459     finally
6460       // destroy row buffer
6461       if Assigned(ConvertBuffer) then begin
6462         FormatDesc.FreeMappingData(SourceFD);
6463         Converter.FreeMappingData(DestFD);
6464         FreeMem(ConvertBuffer);
6465       end;
6466     end;
6467   finally
6468     if Assigned(Converter) then
6469       Converter.Free;
6470   end;
6471 end;
6472
6473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6474 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6476 type
6477   TTGAHeader = packed record
6478     ImageID: Byte;
6479     ColorMapType: Byte;
6480     ImageType: Byte;
6481     //ColorMapSpec: Array[0..4] of Byte;
6482     ColorMapStart: Word;
6483     ColorMapLength: Word;
6484     ColorMapEntrySize: Byte;
6485     OrigX: Word;
6486     OrigY: Word;
6487     Width: Word;
6488     Height: Word;
6489     Bpp: Byte;
6490     ImageDesc: Byte;
6491   end;
6492
6493 const
6494   TGA_UNCOMPRESSED_COLOR_TABLE =  1;
6495   TGA_UNCOMPRESSED_RGB         =  2;
6496   TGA_UNCOMPRESSED_GRAY        =  3;
6497   TGA_COMPRESSED_COLOR_TABLE   =  9;
6498   TGA_COMPRESSED_RGB           = 10;
6499   TGA_COMPRESSED_GRAY          = 11;
6500
6501   TGA_NONE_COLOR_TABLE = 0;
6502   TGA_COLOR_TABLE      = 1;
6503
6504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6505 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6506 var
6507   Header: TTGAHeader;
6508   ImageData: PByte;
6509   StartPosition: Int64;
6510   PixelSize, LineSize: Integer;
6511   tgaFormat: TglBitmapFormat;
6512   FormatDesc: TFormatDescriptor;
6513   Counter: packed record
6514     X, Y: packed record
6515       low, high, dir: Integer;
6516     end;
6517   end;
6518
6519 const
6520   CACHE_SIZE = $4000;
6521
6522   ////////////////////////////////////////////////////////////////////////////////////////
6523   procedure ReadUncompressed;
6524   var
6525     i, j: Integer;
6526     buf, tmp1, tmp2: PByte;
6527   begin
6528     buf := nil;
6529     if (Counter.X.dir < 0) then
6530       buf := GetMem(LineSize);
6531     try
6532       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6533         tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6534         if (Counter.X.dir < 0) then begin               //flip X
6535           aStream.Read(buf^, LineSize);
6536           tmp2 := buf + LineSize - PixelSize;           //pointer to last pixel in line
6537           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6538             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6539               tmp1^ := tmp2^;
6540               inc(tmp1);
6541               inc(tmp2);
6542             end;
6543             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6544           end;
6545         end else
6546           aStream.Read(tmp1^, LineSize);
6547         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6548       end;
6549     finally
6550       if Assigned(buf) then
6551         FreeMem(buf);
6552     end;
6553   end;
6554
6555   ////////////////////////////////////////////////////////////////////////////////////////
6556   procedure ReadCompressed;
6557
6558     /////////////////////////////////////////////////////////////////
6559     var
6560       TmpData: PByte;
6561       LinePixelsRead: Integer;
6562     procedure CheckLine;
6563     begin
6564       if (LinePixelsRead >= Header.Width) then begin
6565         LinePixelsRead := 0;
6566         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6567         TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6568         if (Counter.X.dir < 0) then                       //if x flipped then
6569           TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6570       end;
6571     end;
6572
6573     /////////////////////////////////////////////////////////////////
6574     var
6575       Cache: PByte;
6576       CacheSize, CachePos: Integer;
6577     procedure CachedRead(out Buffer; Count: Integer);
6578     var
6579       BytesRead: Integer;
6580     begin
6581       if (CachePos + Count > CacheSize) then begin
6582         //if buffer overflow save non read bytes
6583         BytesRead := 0;
6584         if (CacheSize - CachePos > 0) then begin
6585           BytesRead := CacheSize - CachePos;
6586           Move(PByteArray(Cache)^[CachePos], Buffer, BytesRead);
6587           inc(CachePos, BytesRead);
6588         end;
6589
6590         //load cache from file
6591         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6592         aStream.Read(Cache^, CacheSize);
6593         CachePos := 0;
6594
6595         //read rest of requested bytes
6596         if (Count - BytesRead > 0) then begin
6597           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6598           inc(CachePos, Count - BytesRead);
6599         end;
6600       end else begin
6601         //if no buffer overflow just read the data
6602         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6603         inc(CachePos, Count);
6604       end;
6605     end;
6606
6607     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6608     begin
6609       case PixelSize of
6610         1: begin
6611           aBuffer^ := aData^;
6612           inc(aBuffer, Counter.X.dir);
6613         end;
6614         2: begin
6615           PWord(aBuffer)^ := PWord(aData)^;
6616           inc(aBuffer, 2 * Counter.X.dir);
6617         end;
6618         3: begin
6619           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6620           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6621           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6622           inc(aBuffer, 3 * Counter.X.dir);
6623         end;
6624         4: begin
6625           PCardinal(aBuffer)^ := PCardinal(aData)^;
6626           inc(aBuffer, 4 * Counter.X.dir);
6627         end;
6628       end;
6629     end;
6630
6631   var
6632     TotalPixelsToRead, TotalPixelsRead: Integer;
6633     Temp: Byte;
6634     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6635     PixelRepeat: Boolean;
6636     PixelsToRead, PixelCount: Integer;
6637   begin
6638     CacheSize := 0;
6639     CachePos  := 0;
6640
6641     TotalPixelsToRead := Header.Width * Header.Height;
6642     TotalPixelsRead   := 0;
6643     LinePixelsRead    := 0;
6644
6645     GetMem(Cache, CACHE_SIZE);
6646     try
6647       TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6648       if (Counter.X.dir < 0) then                       //if x flipped then
6649         TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6650
6651       repeat
6652         //read CommandByte
6653         CachedRead(Temp, 1);
6654         PixelRepeat  := (Temp and $80) > 0;
6655         PixelsToRead := (Temp and $7F) + 1;
6656         inc(TotalPixelsRead, PixelsToRead);
6657
6658         if PixelRepeat then
6659           CachedRead(buf[0], PixelSize);
6660         while (PixelsToRead > 0) do begin
6661           CheckLine;
6662           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6663           while (PixelCount > 0) do begin
6664             if not PixelRepeat then
6665               CachedRead(buf[0], PixelSize);
6666             PixelToBuffer(@buf[0], TmpData);
6667             inc(LinePixelsRead);
6668             dec(PixelsToRead);
6669             dec(PixelCount);
6670           end;
6671         end;
6672       until (TotalPixelsRead >= TotalPixelsToRead);
6673     finally
6674       FreeMem(Cache);
6675     end;
6676   end;
6677
6678   function IsGrayFormat: Boolean;
6679   begin
6680     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6681   end;
6682
6683 begin
6684   result := false;
6685
6686   // reading header to test file and set cursor back to begin
6687   StartPosition := aStream.Position;
6688   aStream.Read(Header, SizeOf(Header));
6689
6690   // no colormapped files
6691   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6692     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6693   begin
6694     try
6695       if Header.ImageID <> 0 then       // skip image ID
6696         aStream.Position := aStream.Position + Header.ImageID;
6697
6698       case Header.Bpp of
6699          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6700                0: tgaFormat := tfLuminance8;
6701                8: tgaFormat := tfAlpha8;
6702             end;
6703
6704         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6705                0: tgaFormat := tfLuminance16;
6706                8: tgaFormat := tfLuminance8Alpha8;
6707             end else case (Header.ImageDesc and $F) of
6708                0: tgaFormat := tfBGR5;
6709                1: tgaFormat := tfBGR5A1;
6710                4: tgaFormat := tfBGRA4;
6711             end;
6712
6713         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6714                0: tgaFormat := tfBGR8;
6715             end;
6716
6717         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6718                2: tgaFormat := tfBGR10A2;
6719                8: tgaFormat := tfBGRA8;
6720             end;
6721       end;
6722
6723       if (tgaFormat = tfEmpty) then
6724         raise EglBitmapException.Create('LoadTga - unsupported format');
6725
6726       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6727       PixelSize  := FormatDesc.GetSize(1, 1);
6728       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6729
6730       GetMem(ImageData, LineSize * Header.Height);
6731       try
6732         //column direction
6733         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6734           Counter.X.low  := Header.Height-1;;
6735           Counter.X.high := 0;
6736           Counter.X.dir  := -1;
6737         end else begin
6738           Counter.X.low  := 0;
6739           Counter.X.high := Header.Height-1;
6740           Counter.X.dir  := 1;
6741         end;
6742
6743         // Row direction
6744         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6745           Counter.Y.low  := 0;
6746           Counter.Y.high := Header.Height-1;
6747           Counter.Y.dir  := 1;
6748         end else begin
6749           Counter.Y.low  := Header.Height-1;;
6750           Counter.Y.high := 0;
6751           Counter.Y.dir  := -1;
6752         end;
6753
6754         // Read Image
6755         case Header.ImageType of
6756           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6757             ReadUncompressed;
6758           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6759             ReadCompressed;
6760         end;
6761
6762         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
6763         result := true;
6764       except
6765         FreeMem(ImageData);
6766         raise;
6767       end;
6768     finally
6769       aStream.Position := StartPosition;
6770     end;
6771   end
6772     else aStream.Position := StartPosition;
6773 end;
6774
6775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6776 procedure TglBitmap.SaveTGA(const aStream: TStream);
6777 var
6778   Header: TTGAHeader;
6779   LineSize, Size, x, y: Integer;
6780   Pixel: TglBitmapPixelData;
6781   LineBuf, SourceData, DestData: PByte;
6782   SourceMD, DestMD: Pointer;
6783   FormatDesc: TFormatDescriptor;
6784   Converter: TFormatDescriptor;
6785 begin
6786   if not (ftTGA in FormatGetSupportedFiles(Format)) then
6787     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
6788
6789   //prepare header
6790   FillChar(Header, SizeOf(Header), 0);
6791
6792   //set ImageType
6793   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
6794                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
6795     Header.ImageType := TGA_UNCOMPRESSED_GRAY
6796   else
6797     Header.ImageType := TGA_UNCOMPRESSED_RGB;
6798
6799   //set BitsPerPixel
6800   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
6801     Header.Bpp := 8
6802   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
6803                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
6804     Header.Bpp := 16
6805   else if (Format in [tfBGR8, tfRGB8]) then
6806     Header.Bpp := 24
6807   else
6808     Header.Bpp := 32;
6809
6810   //set AlphaBitCount
6811   case Format of
6812     tfRGB5A1, tfBGR5A1:
6813       Header.ImageDesc := 1 and $F;
6814     tfRGB10A2, tfBGR10A2:
6815       Header.ImageDesc := 2 and $F;
6816     tfRGBA4, tfBGRA4:
6817       Header.ImageDesc := 4 and $F;
6818     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
6819       Header.ImageDesc := 8 and $F;
6820   end;
6821
6822   Header.Width     := Width;
6823   Header.Height    := Height;
6824   Header.ImageDesc := Header.ImageDesc or $20; //flip y
6825   aStream.Write(Header, SizeOf(Header));
6826
6827   // convert RGB(A) to BGR(A)
6828   Converter  := nil;
6829   FormatDesc := TFormatDescriptor.Get(Format);
6830   Size       := FormatDesc.GetSize(Dimension);
6831   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
6832     if (FormatDesc.RGBInverted = tfEmpty) then
6833       raise EglBitmapException.Create('inverted RGB format is empty');
6834     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
6835     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
6836        (Converter.PixelSize <> FormatDesc.PixelSize) then
6837       raise EglBitmapException.Create('invalid inverted RGB format');
6838   end;
6839
6840   if Assigned(Converter) then begin
6841     LineSize := FormatDesc.GetSize(Width, 1);
6842     LineBuf  := GetMem(LineSize);
6843     SourceMD := FormatDesc.CreateMappingData;
6844     DestMD   := Converter.CreateMappingData;
6845     try
6846       SourceData := Data;
6847       for y := 0 to Height-1 do begin
6848         DestData := LineBuf;
6849         for x := 0 to Width-1 do begin
6850           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
6851           Converter.Map(Pixel, DestData, DestMD);
6852         end;
6853         aStream.Write(LineBuf^, LineSize);
6854       end;
6855     finally
6856       FreeMem(LineBuf);
6857       FormatDesc.FreeMappingData(SourceMD);
6858       FormatDesc.FreeMappingData(DestMD);
6859     end;
6860   end else
6861     aStream.Write(Data^, Size);
6862 end;
6863
6864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6865 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6867 const
6868   DDS_MAGIC                   = $20534444;
6869
6870   // DDS_header.dwFlags
6871   DDSD_CAPS                   = $00000001;
6872   DDSD_HEIGHT                 = $00000002;
6873   DDSD_WIDTH                  = $00000004;
6874   DDSD_PITCH                  = $00000008;
6875   DDSD_PIXELFORMAT            = $00001000;
6876   DDSD_MIPMAPCOUNT            = $00020000;
6877   DDSD_LINEARSIZE             = $00080000;
6878   DDSD_DEPTH                  = $00800000;
6879
6880   // DDS_header.sPixelFormat.dwFlags
6881   DDPF_ALPHAPIXELS            = $00000001;
6882   DDPF_FOURCC                 = $00000004;
6883   DDPF_INDEXED                = $00000020;
6884   DDPF_RGB                    = $00000040;
6885
6886   // DDS_header.sCaps.dwCaps1
6887   DDSCAPS_COMPLEX             = $00000008;
6888   DDSCAPS_TEXTURE             = $00001000;
6889   DDSCAPS_MIPMAP              = $00400000;
6890
6891   // DDS_header.sCaps.dwCaps2
6892   DDSCAPS2_CUBEMAP            = $00000200;
6893   DDSCAPS2_CUBEMAP_POSITIVEX  = $00000400;
6894   DDSCAPS2_CUBEMAP_NEGATIVEX  = $00000800;
6895   DDSCAPS2_CUBEMAP_POSITIVEY  = $00001000;
6896   DDSCAPS2_CUBEMAP_NEGATIVEY  = $00002000;
6897   DDSCAPS2_CUBEMAP_POSITIVEZ  = $00004000;
6898   DDSCAPS2_CUBEMAP_NEGATIVEZ  = $00008000;
6899   DDSCAPS2_VOLUME             = $00200000;
6900
6901   D3DFMT_DXT1                 = $31545844;
6902   D3DFMT_DXT3                 = $33545844;
6903   D3DFMT_DXT5                 = $35545844;
6904
6905 type
6906   TDDSPixelFormat = packed record
6907     dwSize: Cardinal;
6908     dwFlags: Cardinal;
6909     dwFourCC: Cardinal;
6910     dwRGBBitCount: Cardinal;
6911     dwRBitMask: Cardinal;
6912     dwGBitMask: Cardinal;
6913     dwBBitMask: Cardinal;
6914     dwABitMask: Cardinal;
6915   end;
6916
6917   TDDSCaps = packed record
6918     dwCaps1: Cardinal;
6919     dwCaps2: Cardinal;
6920     dwDDSX: Cardinal;
6921     dwReserved: Cardinal;
6922   end;
6923
6924   TDDSHeader = packed record
6925     dwMagic: Cardinal;
6926     dwSize: Cardinal;
6927     dwFlags: Cardinal;
6928     dwHeight: Cardinal;
6929     dwWidth: Cardinal;
6930     dwPitchOrLinearSize: Cardinal;
6931     dwDepth: Cardinal;
6932     dwMipMapCount: Cardinal;
6933     dwReserved: array[0..10] of Cardinal;
6934     PixelFormat: TDDSPixelFormat;
6935     Caps: TDDSCaps;
6936     dwReserved2: Cardinal;
6937   end;
6938
6939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6940 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
6941 var
6942   Header: TDDSHeader;
6943   StreamPos: Int64;
6944   Y, LineSize: Cardinal;
6945   RowSize: Cardinal;
6946   NewImage, pData: pByte;
6947   ddsFormat: TglBitmapFormat;
6948
6949   function RaiseEx : Exception;
6950   begin
6951     result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
6952   end;
6953
6954   function GetDDSFormat: TglBitmapFormat;
6955   begin
6956     with Header.PixelFormat do begin
6957       // Compresses
6958       if (dwFlags and DDPF_FOURCC) > 0 then begin
6959         (* TODO
6960         case Header.PixelFormat.dwFourCC of
6961           D3DFMT_DXT1: result := ifDXT1;
6962           D3DFMT_DXT3: result := ifDXT3;
6963           D3DFMT_DXT5: result := ifDXT5;
6964         else
6965           raise RaiseEx;
6966         end;
6967         *)
6968         raise RaiseEx;
6969       end else
6970
6971       // RGB
6972       if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
6973         case dwRGBBitCount of
6974           8: begin
6975             (* TODO if dwFlags and DDPF_ALPHAPIXELS > 0 then
6976               result := tfAlpha
6977             else
6978             *)
6979               result := tfLuminance8;
6980           end;
6981           16: begin
6982             if dwFlags and DDPF_ALPHAPIXELS > 0 then begin
6983               // Alpha
6984               case CountSetBits(dwRBitMask) of
6985                 5: result := tfRGB5A1;
6986                 //TODO 4: result := tfRGBA4;
6987               else
6988                 result := tfLuminance8Alpha8;
6989               end;
6990             end else begin
6991               // no Alpha
6992               //TODO result := ifR5G6B5;
6993               raise RaiseEx;
6994             end;
6995           end;
6996           24: begin
6997             if dwRBitMask > dwBBitMask then
6998               result := tfBGR8
6999             else
7000               result := tfRGB8;
7001           end;
7002         32: begin
7003             if CountSetBits(dwRBitMask) = 10 then
7004               //TODO result := tfRGB10A2
7005               raise RaiseEx
7006             else
7007
7008             if dwRBitMask > dwBBitMask then
7009               result := tfBGRA8
7010             else
7011               result := tfRGBA8;
7012           end;
7013         else
7014           raise RaiseEx;
7015         end;
7016       end else
7017         raise RaiseEx;
7018     end;
7019   end;
7020
7021 begin
7022   result := false;
7023
7024   // Header
7025   StreamPos := aStream.Position;
7026   aStream.Read(Header, sizeof(Header));
7027
7028   if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
7029      ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin
7030     aStream.Position := StreamPos;
7031     exit;
7032   end;
7033
7034   ddsFormat := GetDDSFormat;
7035   LineSize  := Trunc(Header.dwWidth * TFormatDescriptor.Get(ddsFormat).PixelSize);
7036   GetMem(NewImage, Header.dwHeight * LineSize);
7037   try
7038     pData := NewImage;
7039
7040     // Compressed
7041     if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin
7042       RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7043       for Y := 0 to Header.dwHeight -1 do begin
7044         aStream.Read(pData^, RowSize);
7045         Inc(pData, LineSize);
7046       end;
7047     end else
7048
7049     // RGB(A)
7050     if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
7051       RowSize := Header.dwPitchOrLinearSize;
7052
7053       for Y := 0 to Header.dwHeight -1 do begin
7054         aStream.Read(pData^, RowSize);
7055         Inc(pData, LineSize);
7056       end;
7057     end else
7058       raise RaiseEx;
7059
7060     SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7061     result := true;
7062   except
7063     FreeMem(NewImage);
7064     raise;
7065   end;
7066 end;
7067
7068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7069 procedure TglBitmap.SaveDDS(const aStream: TStream);
7070 var
7071   Header: TDDSHeader;
7072   Pix: TglBitmapPixelData;
7073   FormatDesc: TFormatDescriptor;
7074 begin
7075   //if not FormatIsUncompressed(InternalFormat) then
7076   //  raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
7077
7078   (* TODO if Format = tfAlpha8 then
7079     FORMAT_DESCRIPTORS[tfLuminance8].PreparePixel(Pix);
7080   else    *)
7081     TFormatDescriptor.Get(Format).PreparePixel(Pix);
7082
7083   // Generell
7084   FillChar(Header, SizeOf(Header), 0);
7085   Header.dwMagic := DDS_MAGIC;
7086   Header.dwSize  := 124;
7087   Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
7088
7089   if Width > 0 then begin
7090     Header.dwWidth := Width;
7091     Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
7092   end;
7093
7094   if Height > 0 then begin
7095     Header.dwHeight := Height;
7096     Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
7097   end;
7098
7099   Header.dwPitchOrLinearSize := fRowSize;
7100   Header.dwMipMapCount := 1;
7101
7102   // Caps
7103   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7104
7105   // Pixelformat
7106   Header.PixelFormat.dwSize  := Sizeof(Header.PixelFormat);
7107   Header.PixelFormat.dwFlags := DDPF_RGB;
7108
7109   (* TODO tfAlpha8
7110   if FORMAT_DESCRIPTORS[Format].HasAlpha and (Format <> tfAlpha8) then
7111     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7112   *)
7113
7114   FormatDesc := TFormatDescriptor.Get(Format);
7115   Header.PixelFormat.dwRGBBitCount  := Trunc(FormatDesc.PixelSize * 8);
7116   Header.PixelFormat.dwRBitMask     := FormatDesc.RedMask;
7117   Header.PixelFormat.dwGBitMask     := FormatDesc.GreenMask;
7118   Header.PixelFormat.dwBBitMask     := FormatDesc.BlueMask;
7119   Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
7120
7121   aStream.Write(Header, SizeOf(Header));
7122   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7123 end;
7124
7125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7126 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7128 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7129 begin
7130   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7131     result := fLines[aIndex]
7132   else
7133     result := nil;
7134 end;
7135
7136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7137 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7138   const aWidth: Integer; const aHeight: Integer);
7139 var
7140   Idx, LineWidth: Integer;
7141 begin
7142   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7143
7144   //TODO compression
7145   if {FormatIsUncompressed(Format)} true then begin
7146     (* TODO PixelFuncs
7147     fGetPixelFunc := GetPixel2DUnmap;
7148     fSetPixelFunc := SetPixel2DUnmap;
7149     *)
7150     // Assigning Data
7151     if Assigned(Data) then begin
7152       SetLength(fLines, GetHeight);
7153       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7154
7155       for Idx := 0 to GetHeight -1 do begin
7156         fLines[Idx] := Data;
7157         Inc(fLines[Idx], Idx * LineWidth);
7158       end;
7159     end
7160       else SetLength(fLines, 0);
7161   end else begin
7162     (*
7163     SetLength(fLines, 0);
7164
7165     fSetPixelFunc := nil;
7166
7167     case Format of
7168       ifDXT1:
7169         fGetPixelFunc := GetPixel2DDXT1;
7170       ifDXT3:
7171         fGetPixelFunc := GetPixel2DDXT3;
7172       ifDXT5:
7173         fGetPixelFunc := GetPixel2DDXT5;
7174       else
7175         fGetPixelFunc := nil;
7176     end;
7177     *)
7178   end;
7179 end;
7180
7181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7182 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7183 var
7184   FormatDesc: TFormatDescriptor;
7185 begin
7186   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7187
7188   (* TODO compression
7189   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7190     glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)
7191   else
7192   *)
7193
7194   FormatDesc := TFormatDescriptor.Get(Format);
7195   if aBuildWithGlu then
7196     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7197       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7198   else
7199     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7200       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7201
7202   // Freigeben
7203   if (FreeDataAfterGenTexture) then
7204     FreeData;
7205 end;
7206
7207 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7208 procedure TglBitmap2D.AfterConstruction;
7209 begin
7210   inherited;
7211   Target := GL_TEXTURE_2D;
7212 end;
7213
7214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7215 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7216 var
7217   Temp: pByte;
7218   Size, w, h: Integer;
7219   FormatDesc: TFormatDescriptor;
7220 begin
7221   (* TODO compression
7222   if not FormatIsUncompressed(Format) then
7223     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
7224   *)
7225
7226   w := aRight  - aLeft;
7227   h := aBottom - aTop;
7228   FormatDesc   := TFormatDescriptor.Get(Format);
7229   Size         := FormatDesc.GetSize(w, h);
7230   GetMem(Temp, Size);
7231   try
7232     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7233     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7234     SetDataPointer(Temp, Format, w, h);
7235     FlipVert;
7236   except
7237     FreeMem(Temp);
7238     raise;
7239   end;
7240 end;
7241
7242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7243 procedure TglBitmap2D.GetDataFromTexture;
7244 var
7245   Temp: PByte;
7246   TempWidth, TempHeight: Integer;
7247   TempType, TempIntFormat: Cardinal;
7248   IntFormat, f: TglBitmapFormat;
7249   FormatDesc: TFormatDescriptor;
7250 begin
7251   Bind;
7252
7253   // Request Data
7254   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7255   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7256   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7257
7258   IntFormat := tfEmpty;
7259   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do
7260     if (TFormatDescriptor.Get(f).glInternalFormat = TempIntFormat) then begin
7261       IntFormat := FormatDesc.Format;
7262       break;
7263     end;
7264
7265   // Getting data from OpenGL
7266   FormatDesc := TFormatDescriptor.Get(IntFormat);
7267   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7268   try
7269     (* TODO Compression
7270     if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then
7271       glGetCompressedTexImage(Target, 0, Temp)
7272     else
7273     *)
7274     glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7275     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7276   except
7277     FreeMem(Temp);
7278     raise;
7279   end;
7280 end;
7281
7282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7283 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7284 var
7285   BuildWithGlu, PotTex, TexRec: Boolean;
7286   TexSize: Integer;
7287 begin
7288   if Assigned(Data) then begin
7289     // Check Texture Size
7290     if (aTestTextureSize) then begin
7291       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7292
7293       if ((Height > TexSize) or (Width > TexSize)) then
7294         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7295
7296       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7297       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB);
7298
7299       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7300         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7301     end;
7302
7303     CreateId;
7304     SetupParameters(BuildWithGlu);
7305     UploadData(Target, BuildWithGlu);
7306     glAreTexturesResident(1, @fID, @fIsResident);
7307   end;
7308 end;
7309
7310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7311 function TglBitmap2D.FlipHorz: Boolean;
7312 var
7313   Col, Row: Integer;
7314   TempDestData, DestData, SourceData: PByte;
7315   ImgSize: Integer;
7316 begin
7317   result := inherited FlipHorz;
7318   if Assigned(Data) then begin
7319     SourceData := Data;
7320     ImgSize := Height * fRowSize;
7321     GetMem(DestData, ImgSize);
7322     try
7323       TempDestData := DestData;
7324       Dec(TempDestData, fRowSize + fPixelSize);
7325       for Row := 0 to Height -1 do begin
7326         Inc(TempDestData, fRowSize * 2);
7327         for Col := 0 to Width -1 do begin
7328           Move(SourceData^, TempDestData^, fPixelSize);
7329           Inc(SourceData, fPixelSize);
7330           Dec(TempDestData, fPixelSize);
7331         end;
7332       end;
7333       SetDataPointer(DestData, Format);
7334       result := true;
7335     except
7336       FreeMem(DestData);
7337       raise;
7338     end;
7339   end;
7340 end;
7341
7342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7343 function TglBitmap2D.FlipVert: Boolean;
7344 var
7345   Row: Integer;
7346   TempDestData, DestData, SourceData: PByte;
7347 begin
7348   result := inherited FlipVert;
7349   if Assigned(Data) then begin
7350     SourceData := Data;
7351     GetMem(DestData, Height * fRowSize);
7352     try
7353       TempDestData := DestData;
7354       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7355       for Row := 0 to Height -1 do begin
7356         Move(SourceData^, TempDestData^, fRowSize);
7357         Dec(TempDestData, fRowSize);
7358         Inc(SourceData, fRowSize);
7359       end;
7360       SetDataPointer(DestData, Format);
7361       result := true;
7362     except
7363       FreeMem(DestData);
7364       raise;
7365     end;
7366   end;
7367 end;
7368
7369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7370 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7372 type
7373   TMatrixItem = record
7374     X, Y: Integer;
7375     W: Single;
7376   end;
7377
7378   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7379   TglBitmapToNormalMapRec = Record
7380     Scale: Single;
7381     Heights: array of Single;
7382     MatrixU : array of TMatrixItem;
7383     MatrixV : array of TMatrixItem;
7384   end;
7385
7386 const
7387   ONE_OVER_255 = 1 / 255;
7388
7389   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7390 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7391 var
7392   Val: Single;
7393 begin
7394   with FuncRec do begin
7395     Val :=
7396       Source.Data.r * LUMINANCE_WEIGHT_R +
7397       Source.Data.g * LUMINANCE_WEIGHT_G +
7398       Source.Data.b * LUMINANCE_WEIGHT_B;
7399     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7400   end;
7401 end;
7402
7403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7404 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7405 begin
7406   with FuncRec do
7407     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7408 end;
7409
7410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7411 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7412 type
7413   TVec = Array[0..2] of Single;
7414 var
7415   Idx: Integer;
7416   du, dv: Double;
7417   Len: Single;
7418   Vec: TVec;
7419
7420   function GetHeight(X, Y: Integer): Single;
7421   begin
7422     with FuncRec do begin
7423       X := Max(0, Min(Size.X -1, X));
7424       Y := Max(0, Min(Size.Y -1, Y));
7425       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7426     end;
7427   end;
7428
7429 begin
7430   with FuncRec do begin
7431     with PglBitmapToNormalMapRec(Args)^ do begin
7432       du := 0;
7433       for Idx := Low(MatrixU) to High(MatrixU) do
7434         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7435
7436       dv := 0;
7437       for Idx := Low(MatrixU) to High(MatrixU) do
7438         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7439
7440       Vec[0] := -du * Scale;
7441       Vec[1] := -dv * Scale;
7442       Vec[2] := 1;
7443     end;
7444
7445     // Normalize
7446     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7447     if Len <> 0 then begin
7448       Vec[0] := Vec[0] * Len;
7449       Vec[1] := Vec[1] * Len;
7450       Vec[2] := Vec[2] * Len;
7451     end;
7452
7453     // Farbe zuweisem
7454     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7455     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7456     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7457   end;
7458 end;
7459
7460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7461 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7462 var
7463   Rec: TglBitmapToNormalMapRec;
7464
7465   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7466   begin
7467     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7468       Matrix[Index].X := X;
7469       Matrix[Index].Y := Y;
7470       Matrix[Index].W := W;
7471     end;
7472   end;
7473
7474 begin
7475   (* TODO Compression
7476   if not FormatIsUncompressed(InternalFormat) then
7477     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
7478     *)
7479
7480   if aScale > 100 then
7481     Rec.Scale := 100
7482   else if aScale < -100 then
7483     Rec.Scale := -100
7484   else
7485     Rec.Scale := aScale;
7486
7487   SetLength(Rec.Heights, Width * Height);
7488   try
7489     case aFunc of
7490       nm4Samples: begin
7491         SetLength(Rec.MatrixU, 2);
7492         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7493         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7494
7495         SetLength(Rec.MatrixV, 2);
7496         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7497         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7498       end;
7499
7500       nmSobel: begin
7501         SetLength(Rec.MatrixU, 6);
7502         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7503         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7504         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7505         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7506         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7507         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7508
7509         SetLength(Rec.MatrixV, 6);
7510         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7511         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7512         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7513         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7514         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7515         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7516       end;
7517
7518       nm3x3: begin
7519         SetLength(Rec.MatrixU, 6);
7520         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7521         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7522         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7523         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7524         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7525         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7526
7527         SetLength(Rec.MatrixV, 6);
7528         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7529         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7530         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7531         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7532         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7533         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7534       end;
7535
7536       nm5x5: begin
7537         SetLength(Rec.MatrixU, 20);
7538         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7539         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7540         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7541         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7542         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7543         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7544         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7545         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7546         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7547         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7548         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7549         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7550         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7551         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7552         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7553         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7554         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7555         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7556         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7557         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7558
7559         SetLength(Rec.MatrixV, 20);
7560         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7561         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7562         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7563         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7564         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7565         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7566         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7567         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7568         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7569         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7570         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7571         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7572         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7573         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7574         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7575         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7576         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7577         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7578         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7579         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7580       end;
7581     end;
7582
7583     // Daten Sammeln
7584     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7585       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
7586     else
7587       AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
7588     AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
7589   finally
7590     SetLength(Rec.Heights, 0);
7591   end;
7592 end;
7593
7594
7595
7596
7597
7598
7599
7600
7601
7602 (*
7603 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7604 var
7605   pTemp: pByte;
7606   Size: Integer;
7607 begin
7608   if Height > 1 then begin
7609     // extract first line of the data
7610     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7611     GetMem(pTemp, Size);
7612
7613     Move(Data^, pTemp^, Size);
7614
7615     FreeMem(Data);
7616   end else
7617     pTemp := Data;
7618
7619   // set data pointer
7620   inherited SetDataPointer(pTemp, Format, Width);
7621
7622   if FormatIsUncompressed(Format) then begin
7623     fUnmapFunc := FormatGetUnMapFunc(Format);
7624     fGetPixelFunc := GetPixel1DUnmap;
7625   end;
7626 end;
7627
7628
7629 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7630 var
7631   pTemp: pByte;
7632 begin
7633   pTemp := Data;
7634   Inc(pTemp, Pos.X * fPixelSize);
7635
7636   fUnmapFunc(pTemp, Pixel);
7637 end;
7638
7639
7640 function TglBitmap1D.FlipHorz: Boolean;
7641 var
7642   Col: Integer;
7643   pTempDest, pDest, pSource: pByte;
7644 begin
7645   result := inherited FlipHorz;
7646
7647   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7648     pSource := Data;
7649
7650     GetMem(pDest, fRowSize);
7651     try
7652       pTempDest := pDest;
7653
7654       Inc(pTempDest, fRowSize);
7655       for Col := 0 to Width -1 do begin
7656         Move(pSource^, pTempDest^, fPixelSize);
7657
7658         Inc(pSource, fPixelSize);
7659         Dec(pTempDest, fPixelSize);
7660       end;
7661
7662       SetDataPointer(pDest, InternalFormat);
7663
7664       result := true;
7665     finally
7666       FreeMem(pDest);
7667     end;
7668   end;
7669 end;
7670
7671
7672 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7673 begin
7674   // Upload data
7675   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7676     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7677   else
7678
7679   // Upload data
7680   if BuildWithGlu then
7681     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
7682   else
7683     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
7684
7685   // Freigeben
7686   if (FreeDataAfterGenTexture) then
7687     FreeData;
7688 end;
7689
7690
7691 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
7692 var
7693   BuildWithGlu, TexRec: Boolean;
7694   glFormat, glInternalFormat, glType: Cardinal;
7695   TexSize: Integer;
7696 begin
7697   if Assigned(Data) then begin
7698     // Check Texture Size
7699     if (TestTextureSize) then begin
7700       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7701
7702       if (Width > TexSize) then
7703         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7704
7705       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7706                 (Target = GL_TEXTURE_RECTANGLE_ARB);
7707
7708       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7709         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7710     end;
7711
7712     CreateId;
7713
7714     SetupParameters(BuildWithGlu);
7715     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7716
7717     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
7718
7719     // Infos sammeln
7720     glAreTexturesResident(1, @fID, @fIsResident);
7721   end;
7722 end;
7723
7724
7725 procedure TglBitmap1D.AfterConstruction;
7726 begin
7727   inherited;
7728
7729   Target := GL_TEXTURE_1D;
7730 end;
7731
7732
7733 { TglBitmapCubeMap }
7734
7735 procedure TglBitmapCubeMap.AfterConstruction;
7736 begin
7737   inherited;
7738
7739   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
7740     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
7741
7742   SetWrap; // set all to GL_CLAMP_TO_EDGE
7743   Target := GL_TEXTURE_CUBE_MAP;
7744   fGenMode := GL_REFLECTION_MAP;
7745 end;
7746
7747
7748 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
7749 begin
7750   inherited Bind (EnableTextureUnit);
7751
7752   if EnableTexCoordsGen then begin
7753     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
7754     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
7755     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
7756     glEnable(GL_TEXTURE_GEN_S);
7757     glEnable(GL_TEXTURE_GEN_T);
7758     glEnable(GL_TEXTURE_GEN_R);
7759   end;
7760 end;
7761
7762
7763 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
7764 var
7765   glFormat, glInternalFormat, glType: Cardinal;
7766   BuildWithGlu: Boolean;
7767   TexSize: Integer;
7768 begin
7769   // Check Texture Size
7770   if (TestTextureSize) then begin
7771     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
7772
7773     if ((Height > TexSize) or (Width > TexSize)) then
7774       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
7775
7776     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
7777       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
7778   end;
7779
7780   // create Texture
7781   if ID = 0 then begin
7782     CreateID;
7783     SetupParameters(BuildWithGlu);
7784   end;
7785
7786   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7787
7788   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
7789 end;
7790
7791
7792 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
7793 begin
7794   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
7795 end;
7796
7797
7798 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
7799   DisableTextureUnit: Boolean);
7800 begin
7801   inherited Unbind (DisableTextureUnit);
7802
7803   if DisableTexCoordsGen then begin
7804     glDisable(GL_TEXTURE_GEN_S);
7805     glDisable(GL_TEXTURE_GEN_T);
7806     glDisable(GL_TEXTURE_GEN_R);
7807   end;
7808 end;
7809
7810
7811 { TglBitmapNormalMap }
7812
7813 type
7814   TVec = Array[0..2] of Single;
7815   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7816
7817   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
7818   TglBitmapNormalMapRec = record
7819     HalfSize : Integer;
7820     Func: TglBitmapNormalMapGetVectorFunc;
7821   end;
7822
7823
7824 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7825 begin
7826   Vec[0] := HalfSize;
7827   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7828   Vec[2] := - (Position.X + 0.5 - HalfSize);
7829 end;
7830
7831
7832 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7833 begin
7834   Vec[0] := - HalfSize;
7835   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7836   Vec[2] := Position.X + 0.5 - HalfSize;
7837 end;
7838
7839
7840 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7841 begin
7842   Vec[0] := Position.X + 0.5 - HalfSize;
7843   Vec[1] := HalfSize;
7844   Vec[2] := Position.Y + 0.5 - HalfSize;
7845 end;
7846
7847
7848 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7849 begin
7850   Vec[0] := Position.X + 0.5 - HalfSize;
7851   Vec[1] := - HalfSize;
7852   Vec[2] := - (Position.Y + 0.5 - HalfSize);
7853 end;
7854
7855
7856 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7857 begin
7858   Vec[0] := Position.X + 0.5 - HalfSize;
7859   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7860   Vec[2] := HalfSize;
7861 end;
7862
7863
7864 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7865 begin
7866   Vec[0] := - (Position.X + 0.5 - HalfSize);
7867   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7868   Vec[2] := - HalfSize;
7869 end;
7870
7871
7872 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
7873 var
7874   Vec : TVec;
7875   Len: Single;
7876 begin
7877   with FuncRec do begin
7878     with PglBitmapNormalMapRec (CustomData)^ do begin
7879       Func(Vec, Position, HalfSize);
7880
7881       // Normalize
7882       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7883       if Len <> 0 then begin
7884         Vec[0] := Vec[0] * Len;
7885         Vec[1] := Vec[1] * Len;
7886         Vec[2] := Vec[2] * Len;
7887       end;
7888
7889       // Scale Vector and AddVectro
7890       Vec[0] := Vec[0] * 0.5 + 0.5;
7891       Vec[1] := Vec[1] * 0.5 + 0.5;
7892       Vec[2] := Vec[2] * 0.5 + 0.5;
7893     end;
7894
7895     // Set Color
7896     Dest.Red   := Round(Vec[0] * 255);
7897     Dest.Green := Round(Vec[1] * 255);
7898     Dest.Blue  := Round(Vec[2] * 255);
7899   end;
7900 end;
7901
7902
7903 procedure TglBitmapNormalMap.AfterConstruction;
7904 begin
7905   inherited;
7906
7907   fGenMode := GL_NORMAL_MAP;
7908 end;
7909
7910
7911 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
7912   TestTextureSize: Boolean);
7913 var
7914   Rec: TglBitmapNormalMapRec;
7915   SizeRec: TglBitmapPixelPosition;
7916 begin
7917   Rec.HalfSize := Size div 2;
7918
7919   FreeDataAfterGenTexture := false;
7920
7921   SizeRec.Fields := [ffX, ffY];
7922   SizeRec.X := Size;
7923   SizeRec.Y := Size;
7924
7925   // Positive X
7926   Rec.Func := glBitmapNormalMapPosX;
7927   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7928   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
7929
7930   // Negative X
7931   Rec.Func := glBitmapNormalMapNegX;
7932   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7933   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
7934
7935   // Positive Y
7936   Rec.Func := glBitmapNormalMapPosY;
7937   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7938   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
7939
7940   // Negative Y
7941   Rec.Func := glBitmapNormalMapNegY;
7942   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7943   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
7944
7945   // Positive Z
7946   Rec.Func := glBitmapNormalMapPosZ;
7947   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7948   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
7949
7950   // Negative Z
7951   Rec.Func := glBitmapNormalMapNegZ;
7952   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7953   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
7954 end;
7955 *)
7956
7957 initialization
7958   glBitmapSetDefaultFormat(tfEmpty);
7959   glBitmapSetDefaultMipmap(mmMipmap);
7960   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
7961   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
7962
7963   glBitmapSetDefaultFreeDataAfterGenTexture(true);
7964   glBitmapSetDefaultDeleteTextureOnFree    (true);
7965
7966   TFormatDescriptor.Init;
7967
7968 finalization
7969   TFormatDescriptor.Finalize;
7970
7971 end.
7972