glBitmap.pas

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