glBitmap.pas

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