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