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